this slowpoke moves

Get Whois from URL

Um die komplette Whois einer URL mit seinem eigenen Programm auszulesen, müssen einige Schritte vorgenommen werden.

Generell befindet sich die "Whois.exe" im Systemordner, doch das gilt nur für wenige Systeme.

Der folgende Code führt Whois.exe nicht aus, es wird lediglich der Parameter des Konsolenbefehls genutzt. Deshalb muss die "Whois.exe" für die Lizenzbestimmung mit einem Doppelklick ausgeführt werden. Das gilt nicht für den, der die "Whois.exe" im Systemordner hat.

Schritt 1:
Erstellt ein neues Projekt, speichert es und legt einen Ordner namens "Whois" im Projektordner an.

Schritt 2:
Ladet euch die "Whois.exe" hier : Microsoft 
runter und entpackt die Dateien in den "Whois" Ordner.

Schritt 3:
Doppelklick auf die "Whois.exe" und bestätigt mit "Agree".

Schritt 4:
Nun kommen wir zum Code, wir brauchen eine EditBox, eine Memo und einen Button.

procedure TForm1.FormCreate(Sender: TObject);
begin
  Edit1.Text := 'cmd /c Whois\whois.exe -v www.google.de whois.iana.org';
end;

function ExecConsole(const ACommand: String;
var
  AOutput, AErrors: String;
  AExitCode: Cardinal): Boolean;

var StartupInfo: TStartupInfo;
  ProcessInfo: TProcessInformation;
  SecurityAttr: TSecurityAttributes;
  PipeOutputRead, PipeOutputWrite, PipeErrorsRead, PipeErrorsWrite: THandle;

procedure ReadPipeToString(const hPipe: THandle; var Result: String);
const
  MEM_CHUNK_SIZE = 8192;
var
  NumberOfBytesRead,  NumberOfBytesTotal: Cardinal;
begin
  Result := '';  NumberOfBytesTotal := 0;
  repeat
      SetLength(Result,Length(Result) +MEM_CHUNK_SIZE);
      if ReadFile(hPipe,(@Result[1+NumberOfBytesTotal])^,MEM_CHUNK_SIZE,
                  NumberOfBytesRead,NIL) then
        Inc(NumberOfBytesTotal,NumberOfBytesRead);
      SetLength(Result,NumberOfBytesTotal);
      until
      (NumberOfBytesRead = 0);
  end;
begin
  FillChar(ProcessInfo,SizeOf(TProcessInformation),0);
  FillChar(SecurityAttr,SizeOf(TSecurityAttributes),0);
  SecurityAttr.nLength := SizeOf(SecurityAttr);
  SecurityAttr.bInheritHandle := TRUE;
  SecurityAttr.lpSecurityDescriptor := NIL;
  CreatePipe(PipeOutputRead,PipeOutputWrite,@SecurityAttr,0);
  CreatePipe(PipeErrorsRead,PipeErrorsWrite,@SecurityAttr,0);
  FillChar(StartupInfo,SizeOf(TStartupInfo),0);
  StartupInfo.cb := SizeOf(StartupInfo);
  StartupInfo.hStdInput := 0;
  StartupInfo.hStdOutput := PipeOutputWrite;
  StartupInfo.hStdError := PipeErrorsWrite;
  StartupInfo.wShowWindow := SW_HIDE;
  StartupInfo.dwFlags := STARTF_USESHOWWINDOW or STARTF_USESTDHANDLES;
  Result := CreateProcess(NIL,PChar(ACommand),NIL,NIL,TRUE,
                          CREATE_DEFAULT_ERROR_MODE or CREATE_NEW_CONSOLE
  or NORMAL_PRIORITY_CLASS, NIL,NIL,StartupInfo,ProcessInfo);
  CloseHandle(PipeOutputWrite); CloseHandle(PipeErrorsWrite);
  if (Result) then begin
    ReadPipeToString(PipeOutputRead,AOutput);
    ReadPipeToString(PipeErrorsRead,AErrors);
    WaitForSingleObject(ProcessInfo.hProcess,INFINITE);
    GetExitCodeProcess(ProcessInfo.hProcess,AExitCode);
    CloseHandle(ProcessInfo.hProcess);
  end;  CloseHandle(PipeOutputRead); CloseHandle(PipeErrorsRead);
end;
Beispiel Whois auslesen :
procedure TForm1.Button1Click(Sender: TObject);
var Output, Errors: String; RC: Cardinal; tmp: TStringList;
begin
  Screen.Cursor := crHourGlass;
  tmp := TStringList.Create;
  try
    if ExecConsole(Edit1.Text, Output, Errors,RC) then begin
      //Memo1.Lines.Add('Return-Code des Programms: '+ IntToStr(RC));
      if (Output <> '') then begin
        OemToCharBuffA(PChar(Output),PChar(Output),Length(Output));
        //Memo1.Lines.Add('---Output---');
        tmp.Text :=  Output;
        Memo1.Lines.AddStrings(tmp);
      end; if (Errors <> '') then begin
        OemToCharBuffA(PChar(Errors),PChar(Errors),Length(Errors));
        //Memo1.Lines.Add('---Errors---');
        tmp.Text := Errors;
        Memo1.Lines.AddStrings(tmp); end; end else
      Memo1.Lines.Add('Befehl konnte nicht ausgeführt werden: '+ Edit1.Text);
  finally
  tmp.Free;
  end;
  Memo1.Lines.Add('');
  Screen.Cursor := crDefault;
end;

Keine Kommentare:

Kommentar veröffentlichen

Beliebte Posts

Translate