[Lazarus] Listing wireless networks

[Jürgen Hestermann]

Richard Mace schrieb:
 > Does anyone have any code that will list available wireless networks 
on Win?

I have written the attached program that *sets* a WLAN profile
"SSIDname" (insert your own) with the password "password" (change as 
needed).

On *some* WIN XP machines this code had a side effect I never realy was 
able to resolve:
After adding the WLAN profile with my program I was able to use this 
just added
hot spot but when trying to watch all existing SSIDs with the OS tools 
the machine hang.
This sometimes even happened after restarting the machine so I don't know
what happened here.


I also added code to *get* the data for (one) existing profile(s) but
I am not not sure whether this ever worked. So you need to test.


----------------------------------------------------------------------------
program project1;

{$mode objfpc}{$H+}

uses
  {$IFDEF UNIX}{$IFDEF UseCThreads}
  cthreads,
  {$ENDIF}{$ENDIF}
  Classes,windows;
{$R *.res}

const ProfileXML1 = '<?xml version="1.0"?>'+#13#10+
                  '<WLANProfile 
xmlns="http://www.microsoft.com/networking/WLAN/profile/v1">'+#13#10+
                       '<name>SSIDname</name>'+#13#10+
                       '<SSIDConfig>'+#13#10+
                           '<SSID>'+#13#10+
                               '<name>SSIDname</name>'+#13#10+
                           '</SSID>'+#13#10+
                       '</SSIDConfig>'+#13#10+
                       '<connectionType>ESS</connectionType>'+#13#10+
                       '<connectionMode>auto</connectionMode>'+#13#10+
                       '<autoSwitch>false</autoSwitch>'+#13#10+
                       '<MSM>'+#13#10+
                           '<security>'+#13#10+
                               '<authEncryption>'+#13#10+
                                   
'<authentication>WPA2PSK</authentication>'+#13#10+
                                   '<encryption>AES</encryption>'+#13#10+
                                   '<useOneX>false</useOneX>'+#13#10+
                               '</authEncryption>'+#13#10+
                               '<sharedKey>'+#13#10+
                                   '<keyType>passPhrase</keyType>'+#13#10+
                                   '<protected>false</protected>'+#13#10+
                                   '<keyMaterial>';
const ProfileXML2 = '</keyMaterial>'+#13#10+
                               '</sharedKey>'+#13#10+
                           '</security>'+#13#10+
                       '</MSM>'+#13#10+
                   '</WLANProfile>';
type WLANInterfaceInfoTyp = record
                            InterfaceGuid : GUID;
                            InterfaceDescription : array[0..255] of wchar;
                            State : DWord;
                            end; // of record
     WLANInterfaceInfoListZTyp = ^WLANInterfaceInfoListTyp;
     WLANInterfaceInfoListTyp = record
                                NumberOfItems : DWord;
                                Index : DWord;
                                WLANInterfaceInfo : array[0..10] of 
WLANInterfaceInfoTyp; // ZTyp;
                                end; // of record
function WlanGetProfile(const ClientHandle : Handle;
                        const InterfaceGuid : pGUID;
                        const ProfileName : pwchar;
                        const Reserved : Pvoid;
                          out ProfileXml : pwchar;
                          var Flags : DWord;
                          var GrantedAccess : DWord) : DWord; stdcall; 
external 'wlanapi.dll';
function WlanSetProfile(const ClientHandle : Handle;
                        const InterfaceGuid : GUID;
                        const Flags : DWord;
                        const ProfileXml,
                              AllUserProfileSecurity : pwchar;
                        const Overwrite : Bool;
                        const Reserved : Pvoid;
                          out pdwReasonCode : DWord) : DWord; stdcall; 
external 'wlanapi.dll';
function WlanOpenHandle(ClientVersion : DWord;
                        Reserved : Pointer;
                    var NegotiatedVersion : DWord;
                    var ClientHandle : Handle) : DWord; stdcall; 
external 'wlanapi.dll';
function WlanReasonCodeToString(const ReasonCode : DWord;
                                const BufferSize : DWord;
                                      Buffer : pwchar;
                                const Reserved : Pvoid) : DWord; 
stdcall; external 'wlanapi.dll';
function WlanCloseHandle(const ClientHandle : THandle;
                         const Reserved : Pointer) : DWord; stdcall; 
external 'wlanapi.dll';
function WlanEnumInterfaces(const ClientHandle : THandle;
                                  Reserved : Pointer;
                              var InterfaceList : 
WLANInterfaceInfoListZTyp) : DWord; stdcall; external 'wlanapi.dll';
procedure WlanFreeMemory(const Reserved : Pvoid); stdcall; external 
'wlanapi.dll';
var H               : Handle;
    S,S2            : UnicodeString;
    ReasonCode,
    i               : DWord;
    //ProfileOut      : pwchar;
    InterfaceList   : WLANInterfaceInfoListZTyp;


begin // PROGRAM
InterFaceList := nil;
if WlanOpenHandle(1,nil,i,H)=Error_Success then
   begin
   if WlanEnumInterfaces(H,nil,InterfaceList)=Error_Success then
      begin
      i          := 0;
      { Code to retrieve WLAN profile for first existing SSID. Don't 
know whether it works:
      ProfileOut := nil;
      i := 
WlanGetProfile(H, at InterfaceList^.WLANInterfaceInfo[0].InterfaceGUID,
                            
pwchar(InterfaceList^.WLANInterfaceInfo[0].InterfaceDescription),
                            nil,ProfileOut,i,ReasonCode);
      WLanFreeMemory(ProfileOut);
      ProfileOut := nil;
      }
      S2 := 'password';
      S2 := ProfileXML1+S2+ProfileXML2;
      if WlanSetProfile(H,InterfaceList^.WLANInterfaceInfo[0].InterfaceGUID,
                        
0,pwchar(S2),nil,true,nil,ReasonCode)<>Error_Success then
         begin // Error
         SetLength(S,1000);
         i := WlanReasonCodeToString(ReasonCode,length(S),pwchar(S),nil);
         end;
      end;
   i := WLanCloseHandle(H,nil);
   end;
end.
----------------------------------------------------------------------------