LAN - GetLocalIP, GetComputerName geschrieben am 04.06.2006
Meine Sammlung zum Thema LAN für Delphi:
Delphi/Pascalunit myLan;
interface
uses
WinSock,WinINet,
Windows,SysUtils,Classes;
function GetLocalIP: string; //IP des Rechners
function GetIPs: Tstrings; //alle IPs des netzen
function GetComputerName(IPAddr: string): string; //computername von computerIP
function GetIp(ComputerName: string): string; //computerIP von computer netz-namen
procedure setStatus(wert:string); //Status setzen (von díeser unit)
function getStatus:string; //Status abrufen
function getLANips:boolean;
type
mythread = class(TThread) //Thread der Dateien downloaded
private
{ Private-Deklarationen }
protected
procedure Execute; override;
end;
const
myinet_stat_ok='ok';
myinet_stat_error='error';
myinet_stat_load='load';
myinet_stat_threadwork='work';
myinet_threadabbruch='abbruch';
myinet_threadend='tok';
myinet_threaderror='thread_error';
Browsertypenanz=11;
var
myinet_status:string; //interner arbeitsstatus, siehe folgende const definition
{ myinet_HTTPstatus:string; |ccomd8|
myinet_downloadbyte:Cardinal; |ccomd9|
myinet_filesizebyte:Cardinal; |ccomd10|
myinet_downloadv:real=0; |ccomd11|
}
// URL,OutputFile:string; //URL der zu ladene Datei, Dateiname auf Festplatte
Thread: mythread;
stop_thread:boolean=false; //thread abbrechen?
LANNetzIPs:TStrings; //puffer für Rechner im LAN: "rechnername (ip)"
LANNetzIPz:integer; //aktueller Rechner in Abfrage
myinet_threadfunc:byte;
implementation
//****************************************************************************
function getStatus:string;
begin
result:=myinet_status;
end;
procedure setStatus(wert:string);
begin
myinet_status:=wert;
end;
var merkezeit:TDateTime=0;
merkelastel:Cardinal=0;
//***********************************************************************************
//***********************************************************************************
// CopyURL('http://www.Samples.com/Images/Image001.jpg', 'C:\Downloaded_Image001.jpg')
function GetIp(ComputerName: string): string; //computerIP von computer netz-namen
var
TMPResult: string;
WSA: TWSAData;
H: PHostEnt;
P: PChar;
begin
if WSAStartUp($101, WSA) = 0 then
begin
GetMem(P, 255 + 1);
StrPCopy(P, ComputerName);
H := GetHostByName(P);
FreeMem(P);
if H <> nil then
begin
P := inet_ntoa(PInAddr(H^.h_addr_list^)^);
TMPResult := StrPas(P);
end;
WSACleanUp;
if TMPResult <> '' then
Result := TMPResult
else
Result := '0';
end;
end;
function GetComputerName(IPAddr: string): string; //computername von computerIP
var
SockAddrIn: TSockAddrIn;
HostEnt: PHostEnt;
WSAData: TWSAData;
begin
WSAStartup($101, WSAData);
SockAddrIn.sin_addr.s_addr := inet_addr(PChar(IPAddr));
HostEnt:= GetHostByAddr(@SockAddrIn.sin_addr.S_addr, 4, AF_INET);
if HostEnt <> nil then
Result := StrPas(Hostent^.h_name)
else
Result := '';
end;
function GetLocalIP: string; //IP des Rechners
type
PPInAddr = ^PInAddr;
var
wsadata : TWSAData;
hostinfo : PHostEnt;
addr : PPInAddr;
begin
Result := '';
if(WSAStartUp(MAKEWORD(1,1),wsadata) = 0) then
try
hostinfo := gethostbyname(nil);
if(hostinfo <> nil) then
begin
addr := pointer(hostinfo^.h_addr_list);
while(addr^ <> nil) do
begin
Result := Result + inet_ntoa(addr^^) + ^M^J;
inc(addr);
end;
end;
finally
WSACleanUp; //Dust and Clean
end;
end;
function GetIPs:TStrings;
type
TaPInAddr = array[0..10] of PInAddr;
PaPInAddr = ^TaPInAddr;
var
phe: PHostEnt;
pptr: PaPInAddr;
Buffer: array[0..63] of Char;
I: Integer;
GInitData: TWSAData;
begin
WSAStartup($101, GInitData);
result := TstringList.Create;
result.Clear;
GetHostName(Buffer, Sizeof(Buffer));
result.Add('Buffer:'+Buffer);
phe := GetHostByName(buffer);
result.Add('phe.h_name:'+phe.h_name);
if phe = nil then Exit;
pPtr := PaPInAddr(phe^.h_addr_list);
I := 0;
while pPtr^[I] <> nil do
begin
result.Add(inet_ntoa(pptr^[I]^));
Inc(I);
end;
WSACleanup;
end;
//********** funktionen die über einen thread laufen ****************************
function thgetLANips:boolean;
var localipbase,temp:string;
testip:string;
p:integer;
// ipadressen:Tstrings;
function testeipbase(testip:string):boolean;
var t:integer;
temp,localipbase:string;
begin
result:=false; localipbase:='';
while pos('.',testip)>0 do
begin
localipbase:=localipbase+copy(testip,1,pos('.',testip));
testip:=copy(testip,pos('.',testip)+1,length(testip));
end;
LANNetzIPs.Add('teste IP-Bereich:'+localipbase+'xxx');
// LANNetzIPs.Add('localipbase:'+localipbase+'<');
for t:=1 to 6 do
begin
LANNetzIPs.Add(localipbase+inttostr(t)+' ???');
LANNetzIPz:=t;
temp:=GetComputerName(localipbase+inttostr(t));
if length(temp)>0 then
begin
LANNetzIPs.Delete(LANNetzIPs.Count-1);
LANNetzIPs.Add(localipbase+inttostr(t)+' '+temp);
end
else
begin
LANNetzIPs.Delete(LANNetzIPs.Count-1);
//LANNetzIPs.Add(localipbase+inttostr(t)+' n.b.');
end;
if(stop_thread)then Break;
result:=true;
end;
end;
begin
temp:=GetLocalIP;
localipbase:='';
LANNetzIPs.Clear;
LANNetzIPs.Add('start '+datetostr(now)+' '+timetostr(now));
LANNetzIPs.Add(' ');
// temp:='192.168.0.1'+#13+'192.168.0.1';
if pos(#13,temp)>0 then //mehrere IPs im Rechner?
begin
temp:=temp+#13;
while length(temp)>0 do
begin
p:=pos(#13,temp);
testip:=copy(temp,1,p-1);
temp:=copy(temp,p+1,length(temp));
testeipbase(testip);
if(stop_thread)then begin setStatus(myinet_threadabbruch);Break;end;
end;
end //testip
else
begin
testip:=temp;
testeipbase(testip);
end;
result:=true;
end;
// CopyURL('http://www.Samples.com/Images/Image001.jpg', 'C:\Downloaded_Image001.jpg')
const
BufferSize =2048; //2048Byte= 2kByte Dateipuffer
//var
// hSession, hURL: HInternet;
// dwcode : array[1..20] of char;
// dwIndex,dwCodeLen: integer;
{ HttpQueryInfo(...) |ccomd37|
HTTP_QUERY_MIME_VERSION 0
HTTP_QUERY_CONTENT_TYPE 1 # |ccomd38|
HTTP_QUERY_CONTENT_TRANSFER_ENCODING 2
HTTP_QUERY_CONTENT_ID 3
HTTP_QUERY_CONTENT_DESCRIPTION 4
HTTP_QUERY_CONTENT_LENGTH 5# -in bytes
HTTP_QUERY_CONTENT_LANGUAGE 6# |ccomd39|
HTTP_QUERY_ALLOW 7
HTTP_QUERY_PUBLIC 8
HTTP_QUERY_DATE 9
HTTP_QUERY_EXPIRES 10# |ccomd40|
HTTP_QUERY_LAST_MODIFIED 11
HTTP_QUERY_MESSAGE_ID 12
HTTP_QUERY_URI 13
HTTP_QUERY_DERIVED_FROM 14
HTTP_QUERY_COST 15
HTTP_QUERY_LINK 16
HTTP_QUERY_PRAGMA 17# |ccomd41|
HTTP_QUERY_VERSION 18# |ccomd42|
HTTP_QUERY_STATUS_CODE 19# |ccomd43|
HTTP_QUERY_STATUS_TEXT 20# |ccomd44|
HTTP_QUERY_RAW_HEADERS 21
HTTP_QUERY_RAW_HEADERS_CRLF 22
HTTP_QUERY_CONNECTION 23# |ccomd45|
HTTP_QUERY_ACCEPT 24
HTTP_QUERY_ACCEPT_CHARSET 25
HTTP_QUERY_ACCEPT_ENCODING 26
HTTP_QUERY_ACCEPT_LANGUAGE 27
HTTP_QUERY_AUTHORIZATION 28
HTTP_QUERY_CONTENT_ENCODING 29
HTTP_QUERY_FORWARDED 30
HTTP_QUERY_FROM 31
HTTP_QUERY_IF_MODIFIED_SINCE 32
HTTP_QUERY_LOCATION 33
HTTP_QUERY_ORIG_URI 34
HTTP_QUERY_REFERER 35
HTTP_QUERY_RETRY_AFTER 36
HTTP_QUERY_SERVER 37# |ccomd46|
HTTP_QUERY_TITLE 38
HTTP_QUERY_USER_AGENT 39
HTTP_QUERY_WWW_AUTHENTICATE 40
HTTP_QUERY_PROXY_AUTHENTICATE 41
HTTP_QUERY_ACCEPT_RANGES 42# |ccomd47|
HTTP_QUERY_SET_COOKIE 43
HTTP_QUERY_COOKIE 44
HTTP_QUERY_REQUEST_METHOD 45# |ccomd48|
HTTP_QUERY_REFRESH 46
HTTP_QUERY_CONTENT_DISPOSITION 47
HTTP 1.1 defined headers
HTTP_QUERY_AGE 48
HTTP_QUERY_CACHE_CONTROL 49# private
HTTP_QUERY_CONTENT_BASE 50
HTTP_QUERY_CONTENT_LOCATION 51
HTTP_QUERY_CONTENT_MD5 52
HTTP_QUERY_CONTENT_RANGE 53
HTTP_QUERY_ETAG 54 |ccomd49|
HTTP_QUERY_HOST 55
HTTP_QUERY_IF_MATCH 56
HTTP_QUERY_IF_NONE_MATCH 57
HTTP_QUERY_IF_RANGE 58
HTTP_QUERY_IF_UNMODIFIED_SINCE 59
HTTP_QUERY_MAX_FORWARDS 60
HTTP_QUERY_PROXY_AUTHORIZATION 61
HTTP_QUERY_RANGE 62
HTTP_QUERY_TRANSFER_ENCODING 63# |ccomd50|
HTTP_QUERY_UPGRADE 64
HTTP_QUERY_VARY 65
HTTP_QUERY_VIA 66
HTTP_QUERY_WARNING 67
}
//******************************************************************************
//***************************************************************
function getLANips:boolean;
begin
result:=false;
if(myinet_threadfunc=3)then begin exit;end;
if(myinet_threadfunc>0)then begin Thread.Suspend;Thread.Terminate;end;
myinet_threadfunc:=3;
Thread := mythread.Create(True); //erzeugen aber nicht ausführen
Thread.FreeOnTerminate := True; //beim ende Speicher freigeben
Thread.Resume; //Ausführung eines unterbrochenen Threads
result:=true;
end;
//starten thread mit downloadauftrag
{ Wichtig: Methoden und Eigenschaften eines Objekts in der VCL
können nur in einem Methodenaufruf mit SYNCHRONIZE
genutzt werden, z.B.
Synchronize(UpdateCaption);
und UpdateCaption könnte sein,
procedure mythread.UpdateCaption;
begin
Form1.Caption := 'Updated in einem Thread';
end; }
{ mythread }
procedure mythread.Execute;
begin
try
// Führe hier irgendwelche Berechnungen aus.
//starte hier funktionen in einem thread
setstatus(myinet_stat_threadwork);
case myinet_threadfunc of
3:if(thgetLANips)then setStatus(myinet_stat_OK);
end;
myinet_threadfunc:=0;
except
on e: exception do
begin
// mache hier irgendetwas mit dem Fehler.
setStatus(myinet_threaderror);
end;
end;
end;
initialization
LANNetzIPs := TstringList.Create;
LANNetzIPs.Clear;
LANNetzIPz:=0;
finalization
LANNetzIPs.Free;
end.Der Code basiert aus anderen Sammlungen z.B.
www.delphi-treff.de
www.torry.net
www.swissdelphicenter.ch