Impressum
  • Artikel ist eingeordnet in:
  • Delphi


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




schreibe den ersten Kommentar:


Inhalt zur freien Verwendung gibs es beim Thema Downloads.
nach oben springen
mehr auf: Instagram, github, thingiverse