566 lines
16 KiB
ObjectPascal
566 lines
16 KiB
ObjectPascal
{*******************************************************}
|
|
{ MiTeC System Information Component Suite }
|
|
{ WI-FI Known Networks }
|
|
{ version 14.0.0 }
|
|
{ }
|
|
{ Copyright (c) 1997-2021 Michal Mutl }
|
|
{ }
|
|
{*******************************************************}
|
|
|
|
{$INCLUDE Compilers.inc}
|
|
|
|
unit MSI_WLANC;
|
|
|
|
interface
|
|
|
|
uses {$IFDEF RAD9PLUS}
|
|
WinAPI.Windows, System.SysUtils, System.Classes,
|
|
WinAPI.ActiveX, System.Win.ComObj, MiTeC_SS,
|
|
{$ELSE}
|
|
Windows, SysUtils, Classes, ActiveX, ComObj, MiTeC_SS,
|
|
{$ENDIF}
|
|
MiTeC_Windows, MSI_Common, MSI_Defs;
|
|
|
|
const
|
|
StorageFolderName = 'WLANC';
|
|
|
|
type
|
|
TWLANCRecord = record
|
|
SSID,
|
|
Key,
|
|
Authentication,
|
|
Encryption,
|
|
Connection,
|
|
AdapterName,
|
|
GUID,
|
|
IPAddress: string;
|
|
Timestamp: TDateTime;
|
|
_keyMaterial: string;
|
|
end;
|
|
|
|
TWLANC = array of TWLANCRecord;
|
|
|
|
{$IFDEF RAD9PLUS} [ComponentPlatformsAttribute(pidWin32 or pidWin64)] {$ENDIF}
|
|
TMiTeC_WLANC = class(TMiTeC_Component)
|
|
private
|
|
FData: TWLANC;
|
|
FFiles: TStrings;
|
|
function GetCount: integer;
|
|
function GetRecord(Index: integer): TWLANCRecord;
|
|
procedure AnalyzeFile(AFilename: string);
|
|
procedure RefreshDataXP;
|
|
procedure RefreshDataVista;
|
|
public
|
|
constructor Create(AOwner: TComponent); override;
|
|
destructor Destroy; override;
|
|
procedure Clear; override;
|
|
procedure SaveToStorage(const AFilename: string; var AWriteHeader: Boolean; AFormat: integer = 0; const AComment: string=''; ACodeStream: TCodeStreamProcedure = nil); override;
|
|
function LoadFromStorage(const AFilename: string; var AReadHeader: boolean; ACodeStream: TCodeStreamProcedure = nil): Boolean; override;
|
|
procedure ScanFiles(AUser: string = '');
|
|
procedure RefreshData(AScanObjects: TScanObjects = soAll); override;
|
|
function FindNetwork(const ASSID,AGUID: string): Integer;
|
|
|
|
property Records[Index: integer]: TWLANCRecord read GetRecord;
|
|
published
|
|
property RecordCount: integer read GetCount;
|
|
end;
|
|
|
|
implementation
|
|
|
|
uses {$IFDEF RAD9PLUS}
|
|
XML.XMLDOM, XML.XMLIntf, XML.XMLDoc, XML.Win.msxmldom, System.Win.Registry,
|
|
{$ELSE}
|
|
{$IFDEF FPC}
|
|
DOM, XmlRead,
|
|
{$ELSE}
|
|
xmldom, XMLIntf, msxmldom, XMLDoc,
|
|
{$ENDIF}
|
|
Registry,
|
|
{$ENDIF}
|
|
MiTeC_WinCrypt, MiTeC_Datetime, MiTeC_Routines, MiTeC_SysUtils, MiTeC_RegUtils;
|
|
|
|
{ TMiTeC_WLANC }
|
|
|
|
procedure TMiTeC_WLANC.AnalyzeFile(AFilename: string);
|
|
var
|
|
XMLDoc: TXMLDocument;
|
|
k,n: {$IFDEF FPC}TDOMNode{$ELSE}IXMLNode{$ENDIF};
|
|
r: TWLANCRecord;
|
|
fi: TFileInfo;
|
|
begin
|
|
GetFileInfo(Afilename,fi);
|
|
r.Timestamp:=fi.Modified;
|
|
r.GUID:=ExtractFilename(ExcludeTrailingPathDelimiter(ExtractFilePath(AFilename)));
|
|
{$IFDEF FPC}
|
|
ReadXMLFile(XMLDoc,AFilename);
|
|
n:=XMLDoc.DocumentElement.FindNode('SSIDConfig');
|
|
if n<>nil then begin
|
|
n:=n.FindNode('SSID');
|
|
if n<>nil then
|
|
r.SSID:=n.FindNode('name').TextContent;
|
|
end;
|
|
n:=XMLDoc.DocumentElement.FindNode('connectionType');
|
|
if n<>nil then
|
|
r.Connection:=n.TextContent;
|
|
n:=XMLDoc.DocumentElement.FindNode('MSM');
|
|
if n<>nil then begin
|
|
k:=n.FindNode('security');
|
|
if (k<>nil) then begin
|
|
n:=k.FindNode('authEncryption');
|
|
if n<>nil then begin
|
|
r.Authentication:=n.FindNode('authentication').TextContent;
|
|
r.Encryption:=n.FindNode('encryption').TextContent;
|
|
end;
|
|
n:=k.FindNode('sharedKey');
|
|
if n<>nil then
|
|
r._keyMaterial:=n.FindNode('keyMaterial').TextContent;
|
|
end;
|
|
end;
|
|
if r.SSID<>'' then begin
|
|
SetLength(FData,Length(FData)+1);
|
|
FData[High(FData)]:=r;
|
|
end;
|
|
{$ELSE}
|
|
XMLDoc:=TXMLDocument.Create(Self);
|
|
try
|
|
XMLDoc.FileName:=AFilename;
|
|
XMLDoc.Active:=True;
|
|
n:=XMLDoc.DocumentElement.ChildNodes.FindNode('SSIDConfig');
|
|
if n<>nil then begin
|
|
n:=n.ChildNodes.FindNode('SSID');
|
|
if n<>nil then
|
|
r.SSID:=n.ChildNodes['name'].Text;
|
|
end;
|
|
n:=XMLDoc.DocumentElement.ChildNodes.FindNode('connectionType');
|
|
if n<>nil then
|
|
r.Connection:=n.Text;
|
|
n:=XMLDoc.DocumentElement.ChildNodes.FindNode('MSM');
|
|
if n<>nil then begin
|
|
k:=n.ChildNodes.FindNode('security');
|
|
if (k<>nil) then begin
|
|
n:=k.ChildNodes.FindNode('authEncryption');
|
|
if n<>nil then begin
|
|
r.Authentication:=n.ChildNodes['authentication'].Text;
|
|
r.Encryption:=n.ChildNodes['encryption'].Text;
|
|
end;
|
|
n:=k.ChildNodes.FindNode('sharedKey');
|
|
if n<>nil then
|
|
r._keyMaterial:=n.ChildNodes['keyMaterial'].Text;
|
|
end;
|
|
end;
|
|
if r.SSID<>'' then begin
|
|
SetLength(FData,Length(FData)+1);
|
|
FData[High(FData)]:=r;
|
|
end;
|
|
XMLDoc.Active:=False;
|
|
finally
|
|
XMLDoc.Free;
|
|
end;
|
|
{$ENDIF}
|
|
end;
|
|
|
|
procedure TMiTeC_WLANC.Clear;
|
|
begin
|
|
FFiles.Clear;
|
|
Finalize(FData);
|
|
end;
|
|
|
|
constructor TMiTeC_WLANC.Create(AOwner: TComponent);
|
|
begin
|
|
inherited;
|
|
FFiles:=TStringList.Create;
|
|
end;
|
|
|
|
destructor TMiTeC_WLANC.Destroy;
|
|
begin
|
|
FFiles.Free;
|
|
Finalize(FData);
|
|
inherited;
|
|
end;
|
|
|
|
function TMiTeC_WLANC.FindNetwork(const ASSID, AGUID: string): Integer;
|
|
var
|
|
i: Integer;
|
|
begin
|
|
Result:=-1;
|
|
for i:=0 to High(FData) do
|
|
if SameText(FData[i].SSID,ASSID) and SameText(FData[i].GUID,AGUID) then begin
|
|
Result:=i;
|
|
Break;
|
|
end;
|
|
end;
|
|
|
|
function TMiTeC_WLANC.GetCount: integer;
|
|
begin
|
|
Result:=Length(FData);
|
|
end;
|
|
|
|
function TMiTeC_WLANC.GetRecord(Index: integer): TWLANCRecord;
|
|
begin
|
|
Result:=FData[Index];
|
|
end;
|
|
|
|
function TMiTeC_WLANC.LoadFromStorage;
|
|
|
|
procedure ParseRecord(ASource: string; var ARecord: TWLANCRecord);
|
|
var
|
|
p: Integer;
|
|
begin
|
|
Finalize(Arecord);
|
|
ZeroMemory(@ARecord,SizeOf(ARecord));
|
|
p:=Pos(';',ASource);
|
|
if p=0 then
|
|
Exit;
|
|
ARecord.SSID:=Copy(ASource,1,p-1);
|
|
Delete(ASource,1,p);
|
|
p:=Pos(';',ASource);
|
|
ARecord.Key:=Copy(ASource,1,p-1);
|
|
Delete(ASource,1,p);
|
|
p:=Pos(';',ASource);
|
|
ARecord.Authentication:=Copy(ASource,1,p-1);
|
|
p:=Pos(';',ASource);
|
|
ARecord.Encryption:=Copy(ASource,1,p-1);
|
|
p:=Pos(';',ASource);
|
|
ARecord.Connection:=Copy(ASource,1,p-1);
|
|
Delete(ASource,1,p);
|
|
p:=Pos(';',ASource);
|
|
ARecord.AdapterName:=Copy(ASource,1,p-1);
|
|
p:=Pos(';',ASource);
|
|
ARecord.GUID:=Copy(ASource,1,p-1);
|
|
p:=Pos(';',ASource);
|
|
ARecord.IPAddress:=Copy(ASource,1,p-1);
|
|
Delete(ASource,1,p);
|
|
ARecord.Timestamp:=StrToIntdef(Copy(ASource,1,p-1),0);
|
|
end;
|
|
|
|
var
|
|
stg: IStorage;
|
|
SS: TStructuredStorage;
|
|
Sub: TStructuredStorage;
|
|
strm: TStorageStream;
|
|
i: Integer;
|
|
sl: TStringList;
|
|
r: TWLANCRecord;
|
|
ds: char;
|
|
begin
|
|
Sub:=nil;
|
|
ds:={$IFDEF RAD8PLUS}FormatSettings.{$ENDIF}DecimalSeparator;
|
|
{$IFDEF RAD8PLUS}FormatSettings.{$ENDIF}DecimalSeparator:='.';
|
|
Finalize(FData);
|
|
Result:=inherited LoadFromStorage(AFilename,AReadHeader,ACodeStream);
|
|
if StgIsStorageFile(PWideChar(WideString(AFileName)))<>S_OK then
|
|
Exit;
|
|
OleCheck(StgOpenStorage(PWideChar(WideString(AFileName)),nil,STG_READ_INSTORAGE,nil,LongInt(nil),stg));
|
|
SS:=TStructuredStorage.Create(nil,stg);
|
|
sl:=TStringList.Create;
|
|
try
|
|
Result:=False;
|
|
try
|
|
Sub:=SS.OpenSubStorage(StorageFolderName,STG_READ_INSTORAGE,False);
|
|
except
|
|
Sub:=nil;
|
|
end;
|
|
if Sub<>nil then begin
|
|
strm:=Sub.OpenStream(strm_Data,STG_READ_INSTORAGE,False);
|
|
if strm=nil then
|
|
Exit;
|
|
try
|
|
LoadFromEncodedStream(strm,sl,ACodeStream);
|
|
for i:=0 to sl.Count-1 do begin
|
|
ParseRecord(sl[i],r);
|
|
SetLength(FData,Length(FData)+1);
|
|
FData[High(FData)]:=r;
|
|
end;
|
|
SetDataAvail(True);
|
|
finally
|
|
strm.Free;
|
|
end;
|
|
end;
|
|
finally
|
|
{$IFDEF RAD8PLUS}FormatSettings.{$ENDIF}DecimalSeparator:=ds;
|
|
sl.Free;
|
|
if Sub<>nil then
|
|
Sub.Free;
|
|
SS.Free;
|
|
end;
|
|
end;
|
|
|
|
procedure TMiTeC_WLANC.RefreshDataXP;
|
|
const
|
|
rkWZC = '\SOFTWARE\Microsoft\WZCSVC\Parameters\Interfaces\';
|
|
rkTCPIP = '\SYSTEM\CurrentControlSet\Services\Tcpip\Parameters\Interfaces\';
|
|
rkNC = '\SOFTWARE\Microsoft\Windows NT\CurrentVersion\NetworkCards\';
|
|
var
|
|
i,j: Integer;
|
|
nl,sl: TStringList;
|
|
ip,v: string;
|
|
rdi: TRegDataInfo;
|
|
buf: TByteArray;
|
|
c: array[0..255] of ansichar;
|
|
b: Byte;
|
|
rki: TRegKeyInfo;
|
|
begin
|
|
Finalize(FData);
|
|
sl:=TStringList.Create;
|
|
nl:=TStringList.Create;
|
|
with TRegistry.Create do
|
|
try
|
|
RootKey:=HKEY_LOCAL_MACHINE;
|
|
if OpenKey(rkNC,False) then begin
|
|
GetKeyNames(sl);
|
|
CloseKey;
|
|
for i:=0 to sl.Count-1 do
|
|
if OpenKey(rkNC+sl[i],False) then begin
|
|
nl.Add(ReadString('ServiceName')+'='+ReadString('Description'));
|
|
CloseKey;
|
|
end;
|
|
end;
|
|
if OpenKeyReadOnly(rkWZC) then begin
|
|
GetKeyNames(sl);
|
|
CloseKey;
|
|
for i:=0 to sl.Count-1 do begin
|
|
ip:='0.0.0.0';
|
|
if OpenKeyReadOnly(rkTCPIP+sl[i]) then begin
|
|
if ValueExists('IPAddress') then begin
|
|
GetDataInfo('IPAddress',rdi);
|
|
SetLength(ip,rdi.DataSize);
|
|
ReadBinaryData('IPAddress',ip[1],rdi.DataSize);
|
|
ip:=Trim(ip);
|
|
end;
|
|
if SameText(ip,'0.0.0.0') and ValueExists('DhcpIPAddress') then
|
|
ip:=ReadString('DhcpIPAddress');
|
|
CloseKey;
|
|
end;
|
|
if OpenKeyReadOnly(rkWZC+sl[i]) then begin
|
|
GetKeyInfo(rki);
|
|
for j:=0 to 65535 do begin
|
|
v:=Format('Static#%4.4x',[j]);
|
|
if ValueExists(v) then begin
|
|
GetDataInfo(v,rdi);
|
|
if rdi.RegData=rdBinary then begin
|
|
ZeroMemory(@buf,SizeOf(buf));
|
|
ReadBinaryData(v,buf,rdi.DataSize);
|
|
Zeromemory(@c,SizeOf(c));
|
|
Move(buf[$14],c,buf[$10]);
|
|
if Trim(string(c))<>'' then begin
|
|
SetLength(FData,Length(FData)+1);
|
|
with FData[High(FData)] do begin
|
|
SSID:=Trim(string(c));
|
|
IPAddress:=ip;
|
|
GUID:=sl[i];
|
|
AdapterName:=nl.Values[GUID];
|
|
{$IFDEF FPC}
|
|
TimeStamp:=rki.FileTime;
|
|
{$ELSE}
|
|
TimeStamp:=FileTimeTodateTime(rki.FileTime);
|
|
{$ENDIF}
|
|
Move(buf[$34],b,1);
|
|
case b of
|
|
0: Encryption:='WEP';
|
|
1: Encryption:='Disabled';
|
|
4: Encryption:='TKIP';
|
|
6: Encryption:='AES';
|
|
end;
|
|
Move(buf[$94],b,1);
|
|
case b of
|
|
0: Encryption:='Open';
|
|
1: Encryption:='Shared';
|
|
3,5: Encryption:='WPA';
|
|
4: Encryption:='WPA-PSK';
|
|
6: Encryption:='WPA2';
|
|
7: Encryption:='WPA2-PSK';
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
CloseKey;
|
|
end;
|
|
end;
|
|
end;
|
|
finally
|
|
Free;
|
|
sl.Free;
|
|
nl.Free;
|
|
end;
|
|
end;
|
|
|
|
procedure TMiTeC_WLANC.RefreshData(AScanObjects: TScanObjects = soAll);
|
|
begin
|
|
if (Win32MajorVersion>5) then
|
|
RefreshDataVista
|
|
else
|
|
RefreshDataXP;
|
|
end;
|
|
|
|
procedure TMiTeC_WLANC.RefreshDataVista;
|
|
const
|
|
rkTCPIP = '\SYSTEM\CurrentControlSet\Services\Tcpip\Parameters\Interfaces\';
|
|
rkNC = '\SOFTWARE\Microsoft\Windows NT\CurrentVersion\NetworkCards\';
|
|
var
|
|
DataIn, DataOut: DATA_BLOB;
|
|
pid,i: Integer;
|
|
ph,th: THandle;
|
|
ok: Boolean;
|
|
sid: Cardinal;
|
|
sl,kl: TStringList;
|
|
reg: TRegistry;
|
|
rdi: TRegDataInfo;
|
|
begin
|
|
Finalize(FData);
|
|
ph:=0;
|
|
th:=0;
|
|
ok:=False;
|
|
sid:=DWORD(-1);
|
|
pid:=GetProcessID('winlogon.exe',sid);
|
|
if pid>-1 then begin
|
|
if SetDebugPriv then begin
|
|
ph:=OpenProcess(MAXIMUM_ALLOWED,False,pid);
|
|
if OpenProcessToken(ph,MAXIMUM_ALLOWED,th) then
|
|
ok:=ImpersonateLoggedOnUser(th);
|
|
end;
|
|
end;
|
|
|
|
sl:=TStringList.Create;
|
|
kl:=TStringList.Create;
|
|
reg:=OpenRegistryReadOnly;
|
|
try
|
|
|
|
ScanFiles;
|
|
|
|
for i:=0 to FFiles.Count-1 do
|
|
AnalyzeFile(FFiles[i]);
|
|
|
|
with reg do begin
|
|
RootKey:=HKEY_LOCAL_MACHINE;
|
|
if OpenKey(rkNC,False) then begin
|
|
GetKeyNames(kl);
|
|
CloseKey;
|
|
for i:=0 to kl.Count-1 do
|
|
if OpenKey(rkNC+kl[i],False) then begin
|
|
sl.Add(ReadString('ServiceName')+'='+ReadString('Description'));
|
|
CloseKey;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
for i:=0 to High(FData) do begin
|
|
FData[i].IPAddress:='';
|
|
with reg do
|
|
if OpenKey(rkTCPIP+FData[i].GUID,False) then begin
|
|
if ValueExists('IPAddress') then begin
|
|
GetDataInfo('IPAddress',rdi);
|
|
if rdi.RegData=rdBinary then begin
|
|
SetLength(FData[i].IPAddress,rdi.DataSize);
|
|
ReadBinaryData('IPAddress',FData[i].IPAddress[1],rdi.DataSize);
|
|
FData[i].IPAddress:=Trim(FData[i].IPAddress);
|
|
end else if rdi.RegData=rdString then begin
|
|
FData[i].IPAddress:=Trim(ReadString('IPAddress'));
|
|
end;
|
|
end;
|
|
if (SameText(FData[i].IPAddress,'0.0.0.0') or (FData[i].IPAddress='')) and ValueExists('DhcpIPAddress') then
|
|
FData[i].IPAddress:=ReadString('DhcpIPAddress');
|
|
CloseKey;
|
|
end;
|
|
FData[i].AdapterName:=sl.Values[Fdata[i].GUID];
|
|
if CryptStringToBinary(PChar(FData[i]._keyMaterial),Length(FData[i]._keyMaterial),CRYPT_STRING_HEX,nil,DataIn.cbData,nil,nil) then begin
|
|
DataIn.pbData:=Allocmem(DataIn.cbData);
|
|
if CryptStringToBinary(PChar(FData[i]._keyMaterial),0,CRYPT_STRING_HEX,DataIn.pbData,DataIn.cbData,nil,nil) then begin
|
|
if CryptUnprotectData(@DataIn,nil,nil,nil,nil,0,@DataOut) then
|
|
FData[i].Key:=string(PAnsiChar(DataOut.pbData))
|
|
else if CryptUnprotectData(@DataIn,nil,nil,nil,nil,CRYPTPROTECT_UI_FORBIDDEN,@DataOut) then
|
|
FData[i].Key:=string(PAnsiChar(DataOut.pbData))
|
|
else
|
|
FData[i].Key:=FData[i]._keyMaterial;
|
|
end;
|
|
Freemem(DataIn.pbData);
|
|
end;
|
|
end;
|
|
|
|
finally
|
|
sl.Free;
|
|
kl.Free;
|
|
reg.Free;
|
|
|
|
if ok then
|
|
RevertToSelf;
|
|
if ph>0 then
|
|
CloseHandle(ph);
|
|
if th>0 then
|
|
CloseHandle(th);
|
|
end;
|
|
end;
|
|
|
|
procedure TMiTeC_WLANC.SaveToStorage;
|
|
var
|
|
stg: IStorage;
|
|
SS: TStructuredStorage;
|
|
Sub: TStructuredStorage;
|
|
strm: TStorageStream;
|
|
sl: TStringList;
|
|
i: Integer;
|
|
ds: char;
|
|
begin
|
|
inherited SaveToStorage(AFilename,AWriteHeader,AFormat,AComment,ACodeStream);
|
|
if StgIsStorageFile(PWideChar(WideString(AFileName)))<>S_OK then
|
|
OleCheck(StgCreateDocFile(PWideChar(WideString(AFileName)),STG_CREATE_OPEN,0,stg))
|
|
else
|
|
OleCheck(StgOpenStorage(PWideChar(WideString(AFileName)),nil,STG_OPEN,nil,LongInt(nil),stg));
|
|
SS:=TStructuredStorage.Create(nil,stg);
|
|
Sub:=SS.OpenSubStorage(StorageFolderName,STG_OPEN,True);
|
|
try
|
|
Sub.DeleteElement(strm_Data);
|
|
strm:=Sub.OpenStream(strm_Data,STG_OPEN,True);
|
|
try
|
|
sl:=TStringList.Create;
|
|
ds:={$IFDEF RAD8PLUS}FormatSettings.{$ENDIF}DecimalSeparator;
|
|
{$IFDEF RAD8PLUS}FormatSettings.{$ENDIF}DecimalSeparator:='.';
|
|
try
|
|
for i:=0 to High(FData) do
|
|
sl.Add(Format('%s;%s;%s;%s;%s;%s;%s;%s;%1.10f;',[
|
|
FData[i].SSID,
|
|
FData[i].Key,
|
|
FData[i].Authentication,
|
|
FData[i].Encryption,
|
|
FData[i].Connection,
|
|
FData[i].AdapterName,
|
|
FData[i].GUID,
|
|
FData[i].IPAddress,
|
|
FData[i].Timestamp
|
|
]));
|
|
SaveToEncodedStream(sl,strm,ACodeStream);
|
|
finally
|
|
{$IFDEF RAD8PLUS}FormatSettings.{$ENDIF}DecimalSeparator:=ds;
|
|
sl.Free;
|
|
end;
|
|
finally
|
|
strm.Free;
|
|
end;
|
|
finally
|
|
Sub.Free;
|
|
try
|
|
SS.Free;
|
|
except
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TMiTeC_WLANC.ScanFiles;
|
|
var
|
|
s: string;
|
|
begin
|
|
if not LiveData then
|
|
Exit;
|
|
|
|
if AUser='' then
|
|
AUser:=WindowsUser;
|
|
|
|
FFiles.Clear;
|
|
s:=IncludeTrailingPathDelimiter(GetSpecialFolderEx(AUser,CSIDL_COMMON_APPDATA))+'Microsoft\Wlansvc\Profiles\Interfaces\';
|
|
BuildFileList(s,'*.xml',faAnyFile,FFiles,True);
|
|
end;
|
|
|
|
end.
|
|
|