如何正確取得Client端一組唯一識別碼?

發表時間：2007-05-29 10:14:20

IP:60.248.xxx.xxx 未訂閱

本人參照http://delphi.ktop.com.tw/board.php?cid=30&fid=67&tid=64601貼文
把取得mac及ip封裝成一個class

<textarea class="delphi" rows="10" cols="60" name="code">uses Windows,Classes,SysUtils; type TMachineID=record pcname:string; mac:string; ip:string; end; TClientMachineIdentification=class private hname:string; macname:string; macadd:string; macindex:string; FInfoList:TStrings; Procedure GetNetworkParameters; Procedure GetAdapterInformation; Function MACToStr(ByteArr : PByte; Len : Integer) : String; public constructor Create; destructor Destroy; function GetMachineId:TMachineId; function GetFullInfo:TStrings; function GetIdeSerialNumber() : PChar; end; implementation Const MAX_HOSTNAME_LEN = 128; { from IPTYPES.H } MAX_DOMAIN_NAME_LEN = 128; MAX_SCOPE_ID_LEN = 256; MAX_ADAPTER_NAME_LENGTH = 256; MAX_ADAPTER_DEforbiddenION_LENGTH = 128; MAX_ADAPTER_ADDRESS_LENGTH = 8; Type TIPAddressString = Array[0..4*4-1] of Char; PIPAddrString = ^TIPAddrString; TIPAddrString = Record Next : PIPAddrString; IPAddress : TIPAddressString; IPMask : TIPAddressString; Context : Integer; End; PFixedInfo = ^TFixedInfo; TFixedInfo = Record { FIXED_INFO } HostName : Array[0..MAX_HOSTNAME_LEN 3] of Char; DomainName : Array[0..MAX_DOMAIN_NAME_LEN 3] of Char; CurrentDNSServer : PIPAddrString; DNSServerList : TIPAddrString; NodeType : Integer; ScopeId : Array[0..MAX_SCOPE_ID_LEN 3] of Char; EnableRouting : Integer; EnableProxy : Integer; EnableDNS : Integer; End; PIPAdapterInfo = ^TIPAdapterInfo; TIPAdapterInfo = Record { IP_ADAPTER_INFO } Next : PIPAdapterInfo; ComboIndex : Integer; AdapterName : Array[0..MAX_ADAPTER_NAME_LENGTH 3] of Char; Deforbiddenion : Array[0..MAX_ADAPTER_DEforbiddenION_LENGTH 3] of Char; AddressLength : Integer; Address : Array[1..MAX_ADAPTER_ADDRESS_LENGTH] of Byte; Index : Integer; _Type : Integer; DHCPEnabled : Integer; CurrentIPAddress : PIPAddrString; IPAddressList : TIPAddrString; GatewayList : TIPAddrString; DHCPServer : TIPAddrString; HaveWINS : Bool; PrimaryWINSServer : TIPAddrString; SecondaryWINSServer : TIPAddrString; LeaseObtained : Integer; LeaseExpires : Integer; End; var FI : PFixedInfo; AI,Work : PIPAdapterInfo; MachineId:TMachineId; Function GetNetworkParams(FI : PFixedInfo; Var BufLen : Integer) : Integer; StdCall; External 'iphlpapi.dll' Name 'GetNetworkParams'; Function GetAdaptersInfo(AI : PIPAdapterInfo; Var BufLen : Integer) : Integer; StdCall; External 'iphlpapi.dll' Name 'GetAdaptersInfo'; { TClientMachineIdentification } constructor TClientMachineIdentification.Create; begin inherited; FInfoList:=TStringList.Create; GetNetworkParameters; MachineId.pcname:=FI^.HostName; GetAdapterInformation; end; destructor TClientMachineIdentification.Destroy; begin FInfoList.Free; end; procedure TClientMachineIdentification.GetAdapterInformation; Var Size : Integer; Res : Integer; I : Integer; Function GetAddrString(Addr : PIPAddrString) : String; var idx:Integer; Begin Result := ''; idx:=0; While (Addr <> nil) do Begin Result := Result 'A: ' Addr^.IPAddress ' M: ' Addr^.IPMask #13; Addr := Addr^.Next; Inc(idx); End; End; Function TimeTToDateTimeStr(TimeT : Integer) : String; Const UnixDateDelta = 25569; { days between 12/31/1899 and 1/1/1970 } Var DT : TDateTime; TZ : TTimeZoneInformation; Res : DWord; Begin If (TimeT = 0) Then Result := '' Else Begin { Unix TIME_T is secs since 1/1/1970 } DT := UnixDateDelta (TimeT / (24*60*60)); { in UTC } { calculate bias } Res := GetTimeZoneInformation(TZ); If (Res = TIME_ZONE_ID_INVALID) Then RaiseLastWin32Error; If (Res = TIME_ZONE_ID_STANDARD) Then Begin DT := DT-((TZ.Bias TZ.StandardBias) / (24*60)); Result := DateTimeToStr(DT) ' ' WideCharToString(TZ.StandardName); End Else Begin { daylight saving time } DT := DT-((TZ.Bias TZ.DaylightBias) / (24*60)); Result := DateTimeToStr(DT) ' ' WideCharToString(TZ.DaylightName); End; End; End; begin Size := 5120; GetMem(AI,Size); Res := GetAdaptersInfo(AI,Size); If (Res <> ERROR_SUCCESS) Then Begin SetLastError(Res); RaiseLastWin32Error; End; With Self.FInfoList do Begin Work := AI; I := 1; macname:=Work^.AdapterName; macadd:=MACToStr(@Work^.Address,Work^.AddressLength); macindex:=IntToStr(Work^.Index); { IniFileName := ChangeFileext(Application.ExeName,'.ini'); with TINIFile.Create(IniFileName) do try //保存目前TForm物件的座標屬性 WriteString('userinfo','Host name',hname); WriteString('userinfo','Adapter name',macname); WriteString('userinfo','Adapter address',macadd); WriteString('userinfo','Index',macindex); finally //釋放TINIFile對象 Free; TINIFile.Create('mac.ini'); //保存目前TForm物件的座標屬性 WriteString('userinfo','Host name',hname); WriteString('userinfo','Adapter name',macname); WriteString('userinfo','Adapter address',macadd); WriteString('userinfo','Index',macindex); Free; end; } Repeat Add(#13#10 'Adapter ' IntToStr(I)); Add(' ComboIndex: ' IntToStr(Work^.ComboIndex)); Add(' Adapter name: ' Work^.AdapterName); //name:=Work^.AdapterName; //Add(' Deforbiddenion: ' Work^.Deforbiddenion); Add(' Adapter address: ' MACToStr(@Work^.Address,Work^.AddressLength)); if i=1 then begin MachineId.mac:=MACToStr(@Work^.Address,Work^.AddressLength); MachineId.mac:=StringReplace(MachineId.mac,'-','',[rfReplaceAll]); end; Add(' Index: ' IntToStr(Work^.Index)); Add(' Type: ' IntToStr(Work^._Type)); Add(' DHCP: ' IntToStr(Work^.DHCPEnabled)); Add(' Current IP: ' GetAddrString(Work^.CurrentIPAddress)); Add(' IP addresses: ' GetAddrString(@Work^.IPAddressList)); if i=1 then begin MachineId.ip:=GetAddrString(@Work^.IPAddressList); MachineId.ip:=copy(MachineId.ip,4,pos('M',MachineId.ip)-5); end; Add(' Gateways: ' GetAddrString(@Work^.GatewayList)); Add(' DHCP servers: ' GetAddrString(@Work^.DHCPServer)); Add(' Has WINS: ' IntToStr(Integer(Work^.HaveWINS))); Add(' Primary WINS: ' GetAddrString(@Work^.PrimaryWINSServer)); Add(' Secondary WINS: ' GetAddrString(@Work^.SecondaryWINSServer)); Add(' Lease obtained: ' TimeTToDateTimeStr(Work^.LeaseObtained)); Add(' Lease expires: ' TimeTToDateTimeStr(Work^.LeaseExpires)); Inc(I); Work := Work^.Next; Until (Work = nil); End; FreeMem(AI); end; function TClientMachineIdentification.GetFullInfo: TStrings; begin Result:=FInfoList; end; function TClientMachineIdentification.GetIdeSerialNumber: PChar; const IDENTIFY_BUFFER_SIZE = 512; type TIDERegs = packed record bFeaturesReg: BYTE; // Used for specifying SMART "commands". bSectorCountReg: BYTE; // IDE sector count register bSectorNumberReg: BYTE; // IDE sector number register bCylLowReg: BYTE; // IDE low order cylinder value bCylHighReg: BYTE; // IDE high order cylinder value bDriveHeadReg: BYTE; // IDE drive/head register bCommandReg: BYTE; // Actual IDE command. bReserved: BYTE; // reserved for future use. Must be zero. end; TSendCmdInParams = packed record // Buffer size in bytes cBufferSize: DWORD; // Structure with drive register values. irDriveRegs: TIDERegs; // Physical drive number to send command to (0,1,2,3). bDriveNumber: BYTE; bReserved: array[0..2] of Byte; dwReserved: array[0..3] of DWORD; bBuffer: array[0..0] of Byte; // Input buffer. end; TIdSector = packed record wGenConfig: Word; wNumCyls: Word; wReserved: Word; wNumHeads: Word; wBytesPerTrack: Word; wBytesPerSector: Word; wSectorsPerTrack: Word; wVendorUnique: array[0..2] of Word; sSerialNumber: array[0..19] of CHAR; wBufferType: Word; wBufferSize: Word; wECCSize: Word; sFirmwareRev: array[0..7] of Char; sModelNumber: array[0..39] of Char; wMoreVendorUnique: Word; wDoubleWordIO: Word; wCapabilities: Word; wReserved1: Word; wPIOTiming: Word; wDMATiming: Word; wBS: Word; wNumCurrentCyls: Word; wNumCurrentHeads: Word; wNumCurrentSectorsPerTrack: Word; ulCurrentSectorCapacity: DWORD; wMultSectorStuff: Word; ulTotalAddressableSectors: DWORD; wSingleWordDMA: Word; wMultiWordDMA: Word; bReserved: array[0..127] of BYTE; end; PIdSector = ^TIdSector; TDriverStatus = packed record // 驅動器返回的錯誤代碼，無錯則返回0 bDriverError: Byte; // IDE出錯寄存器的內容，只有當bDriverError 為 SMART_IDE_ERROR 時有效 bIDEStatus: Byte; bReserved: array[0..1] of Byte; dwReserved: array[0..1] of DWORD; end; TSendCmdOutParams = packed record // bBuffer的大小 cBufferSize: DWORD; // 驅動器狀態 DriverStatus: TDriverStatus; // 用於保存從驅動器讀出的資料的緩衝區，實際長度由cBufferSize決定 bBuffer: array[0..0] of BYTE; end; var hDevice : THandle; cbBytesReturned : DWORD; SCIP : TSendCmdInParams; aIdOutCmd : array[0..(SizeOf(TSendCmdOutParams) IDENTIFY_BUFFER_SIZE - 1) - 1] of Byte; IdOutCmd : TSendCmdOutParams absolute aIdOutCmd; procedure ChangeByteOrder(var Data; Size: Integer); var ptr : PChar; i : Integer; c : Char; begin ptr := @Data; for I := 0 to (Size shr 1) - 1 do begin c := ptr^; ptr^ := (ptr 1)^; (ptr 1)^ := c; Inc(ptr, 2); end; end; begin Result := ''; // 如果出錯則返回空串 if SysUtils.Win32Platform = VER_PLATFORM_WIN32_NT then // Windows NT, Windows 2000 begin // 提示! 改變名稱可適用於其他驅動器，如第二個驅動器： '\.PhysicalDrive1' hDevice := CreateFile('\.PhysicalDrive1', GENERIC_READ or GENERIC_WRITE, FILE_SHARE_READ or FILE_SHARE_WRITE, nil, OPEN_EXISTING, 0, 0); end else // Version Windows 95 OSR2, Windows 98 hDevice := CreateFile('\.SMARTVSD', 0, 0, nil, CREATE_NEW, 0, 0); if hDevice = INVALID_HANDLE_VALUE then Exit; try FillChar(SCIP, SizeOf(TSendCmdInParams) - 1, #0); FillChar(aIdOutCmd, SizeOf(aIdOutCmd), #0); cbBytesReturned := 0; // Set up data structures for IDENTIFY command. with SCIP do begin cBufferSize := IDENTIFY_BUFFER_SIZE; // bDriveNumber := 0; with irDriveRegs do begin bSectorCountReg := 1; bSectorNumberReg := 1; // if Win32Platform=VER_PLATFORM_WIN32_NT then bDriveHeadReg := $A0 // else bDriveHeadReg := $A0 or ((bDriveNum and 1) shl 4); bDriveHeadReg := $A0; bCommandReg := $EC; end; end; if not DeviceIoControl(hDevice, $0007C088, @SCIP, SizeOf(TSendCmdInParams) - 1, @aIdOutCmd, SizeOf(aIdOutCmd), cbBytesReturned, nil) then Exit; finally CloseHandle(hDevice); end; with PIdSector(@IdOutCmd.bBuffer)^ do begin ChangeByteOrder(sSerialNumber, SizeOf(sSerialNumber)); (Pchar(@sSerialNumber) SizeOf(sSerialNumber))^ := #0; Result := Pchar(@sSerialNumber); end; end; function TClientMachineIdentification.GetMachineId: TMachineId; begin Result:=MachineId; end; procedure TClientMachineIdentification.GetNetworkParameters; Var Size : Integer; Res : Integer; I : Integer; DNS : PIPAddrString; begin Size := 1024; GetMem(FI,Size); Res := GetNetworkParams(FI,Size); hname:=FI^.HostName; If (Res <> ERROR_SUCCESS) Then Begin SetLastError(Res); RaiseLastWin32Error; End; With Self.FInfoList do Begin Clear; Add('Hostname : ' FI^.HostName); Add('Domain name: ' FI^.DomainName); If (FI^.CurrentDNSServer <> nil) Then Add('Current DNS Server: ' FI^.CurrentDNSServer^.IPAddress) Else Add('Current DNS Server: (none)'); I := 1; DNS := @FI^.DNSServerList; Repeat Add('DNS ' IntToStr(I) ': ' DNS^.IPAddress); Inc(I); DNS := DNS^.Next; Until (DNS = nil); Add('Scope ID: ' FI^.ScopeId); Add('Routing: ' IntToStr(FI^.EnableRouting)); Add('Proxy: ' IntToStr(FI^.EnableProxy)); Add('DNS: ' IntToStr(FI^.EnableDNS)); End; FreeMem(FI); end; function TClientMachineIdentification.MACToStr(ByteArr: PByte; Len: Integer): String; begin Result := ''; While (Len > 0) do Begin Result := Result IntToHex(ByteArr^,2) '-'; ByteArr := Pointer(Integer(ByteArr) SizeOf(Byte)); Dec(Len); End; SetLength(Result,Length(Result)-1); { remove last dash } end; end. </textarea>

使用方法
cmi:=TClientMachineIdentification.Create;
MachineId:=cmi.GetMachineId;

我的問題點是我的環境比較複雜,有好幾個網卡一個實體的 2組VMWare配置出來的
每次取得的ip及pcname都不一樣,
請問是否有前輩有處理此問題的類似經驗(我對網路領域沒什麼概念),能否指導一下我的問題出在哪裡?
謝謝