Windows Programming Tips

From Free Pascal wiki
Revision as of 09:44, 16 July 2011 by BigChimp (talk | contribs) (Added source in text)
Jump to navigationJump to search
The printable version is no longer supported and may have rendering errors. Please update your browser bookmarks and please use the default browser print function instead.

This page is dedicated to desktop Windows programming tips.

Other Interfaces

Platform specific Tips

Interface Development Articles

Code snippets

Listing all available drives

<delphi> program listdevices;

{$ifdef fpc}{$mode delphi}{$endif} {$apptype console}

uses

 Windows;

var

 Drive: Char;
 DriveLetter: string;

begin

 WriteLn('The following drives were found in this computer:');
 WriteLn();
 // Search all drive letters
 for Drive := 'A' to 'Z' do
 begin
   DriveLetter := Drive + ':\';
  
   case GetDriveType(PChar(DriveLetter)) of
    DRIVE_REMOVABLE: WriteLn(DriveLetter + ' Floppy Drive');
    DRIVE_FIXED:     WriteLn(DriveLetter + ' Fixed Drive');
    DRIVE_REMOTE:    WriteLn(DriveLetter + ' Network Drive');
    DRIVE_CDROM:     WriteLn(DriveLetter + ' CD-ROM Drive');
    DRIVE_RAMDISK:   WriteLn(DriveLetter + ' RAM Disk');
   end;
 end;
 // Also add a stop to see the result under Windows
 WriteLn();
 WriteLn('Please press <ENTER> to exit the program.');
 ReadLn(DriveLetter);

end. </delphi>

Creating a shortcut (.lnk) file

Taken from forum post by Lainz: Windows Startup post on forum

<delphi> UNIT shortcut;

INTERFACE

 uses windows;
 FUNCTION createShortcut(lnkpos : widestring; dstfn,dstargs,dstwdir,descr,iconfn : AnsiString; iconnum : longint) : boolean;
 // create a windows shortcut file (*.lnk)@lnkpos.
 // example: createSohrtcut('c:\test.lnk','c:\pascal\myprog.exe','-L 1000','c:\pascal','A nice Program.','c:\pascal\myprog.exe',0);

IMPLEMENTATION

TYPE REFCLSID = PGUID; REFIID = PGUID;

CONST CLSID_ShellLink : TGUID = '{00021401-0000-0000-C000-000000000046}'; IID_IShellLink : TGUID = '{000214EE-0000-0000-C000-000000000046}'; IID_IPersistFile : TGUID = '{0000010b-0000-0000-C000-000000000046}'; CLSCTX_INPROC_SERVER = 1;

FUNCTION CoInitialize(p : pointer) : HRESULT; stdcall; external 'ole32.dll'; FUNCTION CoUninitialize(p : pointer) : HRESULT; stdcall; external 'ole32.dll'; FUNCTION CoCreateInstance(a:REFCLSID; b:pointer; c:DWORD; d:REFIID; e:pointer) : HRESULT; stdcall; external 'ole32.dll';

TYPE PPISHellLink = ^PISHellLink; PISHellLink = ^ISHellLink; ISHellLink = packed record

 QueryInterface : FUNCTION(basis,id,p : pointer) : Hresult; stdcall;
 AddRef : FUNCTION(basis : pointer) : Hresult; stdcall;
 Release : FUNCTION(basis : pointer) : Hresult; stdcall;
 GetPath : pointer;
 GetIDList : pointer;
 SetIDList : pointer;
 GetDescription : pointer;
 SetDescription : FUNCTION(basis : pointer; descr : Pchar) : Hresult; stdcall;
 GetWorkingDirectory : pointer;
 SetWorkingDirectory : FUNCTION(basis : pointer; descr : Pchar) : Hresult; stdcall;
 GetArguments : pointer;
 SetArguments : FUNCTION(basis : pointer; args : Pchar) : Hresult; stdcall;
 GetHotkey : pointer;
 SetHotkey : pointer;
 GetShowCmd : pointer;
 SetShowCmd : pointer;
 GetIconLocation : pointer;
 SetIconLocation : FUNCTION(basis : pointer; iconfile : Pchar; icon : longint) : Hresult; stdcall;
 SetRelativePath : pointer;
 Resolve : pointer;
 SetPath : FUNCTION(basis : pointer; path : Pchar) : Hresult; stdcall;

end;

PPIPersistFile = ^PIPersistFile; PIPersistFile = ^IPersistFile; IPersistFile = packed record

 QueryInterface : FUNCTION(basis,id,p : pointer) : Hresult; stdcall;
 AddRef : FUNCTION(basis : pointer) : Hresult; stdcall;
 Release : FUNCTION(basis : pointer) : Hresult; stdcall;
 GetClassID : FUNCTION(basis,p : pointer) : Hresult; stdcall;
 IsDirty : FUNCTION(basis : pointer) : Hresult; stdcall;
 Load : FUNCTION(basis : pointer; fn : Pchar; dw : dword) : Hresult; stdcall;
 Save : FUNCTION(basis : pointer; fn : Pchar; dw : dword) : Hresult; stdcall;
 SaveCompleted : FUNCTION(basis : pointer; fn : Pchar) : Hresult; stdcall;
 GetCurFile : FUNCTION(basis : pointer; fn : PPchar) : Hresult; stdcall;

end;


FUNCTION createShortcut(lnkpos : widestring; dstfn,dstargs,dstwdir,descr,iconfn : AnsiString; iconnum : longint) : boolean; VAR psl : PPISHellLink; psp : PPIPersistFile; BEGIN

 createShortcut := FALSE;
 if CoCreateInstance(@CLSID_ShellLink,nil,CLSCTX_INPROC_SERVER,@IID_IShellLink,@psl)=0 then begin

// writeln('got IShellLink');

   if  (psl^^.setPath(psl,@dstfn[1])=0)
   and (psl^^.SetArguments(psl,@dstargs[1])=0)
   and (psl^^.SetWorkingDirectory(psl,@dstwdir[1])=0)
   and (psl^^.SetDescription(psl,@descr[1])=0)
   and (psl^^.SetIconLocation(psl,@iconfn[1],iconnum)=0)
   and (psl^^.queryInterface(psl,@IID_IPersistFile,@psp)=0) then begin
     if psp^^.save(psp,@lnkpos[1],0)=0 then createShortcut := true;   
     psp^^.release(psp);
   end;
   psl^^.Release(psl);
 end;

END;

BEGIN

 CoInitialize(nil);

END. </delphi>