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