VERIFICARE LA PRESENZA DI UNA SCHEDA AUDIO

Prima di effettuare operazioni di qualsiasi tipo sulla scheda audio è necessario verificare che la stessa sia installata correttamente sulla macchina.

Per verificare la presenza di una scheda audio sul sistema è necessario ricorrere alla funzione waveOutGetNumDevs, che restituisce il numero di periferiche installate. Il valore restituito 0 indica la mancanza di una scheda audio o la presenza di un errore.

Function IsSoundCardInstalled: Boolean;
Begin
   Result := waveOutGetNumDevs > 0;
End;

Prima di invocare la funzione waveOutGetNumDevs è necessario includere la unit MMSystem.

SU^

CONOSCERE IL TIPO DI UN DRIVE

Esiste una funzione molto utile che ritorna il tipo di unità in base alla root del drive specificato come parametro. Questa funzione si chiama GetDriveType e analizziamo il suo funzionamento con un esempio molto semplice:

Procedure ShowDriveType(Drive: Char);
Begin
  Case GetDriveType(PChar(Drive + ':\')) of
    0: ShowMessage('The drive type cannot be determined');
    1: ShowMessage('The root directory does not exist');
    DRIVE_REMOVABLE: ShowMessage(Drive Removable / Diskette');
    DRIVE_FIXED: ShowMessage('Drive Fixed');
    DRIVE_CDROM: ShowMessage('CD-ROM Drive');
    DRIVE_RAMDISK: ShowMessage('RAM Drive');
    DRIVE_REMOTE: ShowMessage('Remote Drive');
  End;
End;

Alcuni esempi di invocazione della procedura ShowDriveType sono i seguenti:

ShowDriveType('A');
ShowDriveType('C');
ShowDriveType('D');

SU^

OTTENERE IL PATH DELL'APPLICAZIONE

Qualche volta è necessario ottenere il path della propria applicazione, senza usare file o altri sistemi di supporto per la memorizzazione delle informazioni.

Il path della propria applicazione si può ottenere facilmente in questo modo:

Path := ExtractFilePath(Application.ExeName);

ExeName è una proprietà a sola lettura della classe TApplication, che contiene il riferimento assoluto dell'eseguibile, che per default è uguale a PROJECT1.EXE.

SU^

DIVIDERE UN FILE

Questo tip è particolarmente utile per chi vuole implementare un proprio meccanismo di backup.

Var inFile, OutFile: FILE;
      CopyBuffer: POINTER;
      iRecsOK, iRecsWr, iX: Integer;
      sfileName: String;
CONST ChunkSize: LONGINT = 1400000 // Dimensione tipo floppy 1.44 MB
Begin
   GETMEM(CopyBuffer, ChunkSize);
   SfileName := 'C:\TEMP\NomeFileDaDividere';
   AssignFile(infile, sFileName + '.doc');
   Reset(InFile, 1);
   iX := 1;
   Repeat
     AssignFile(OutFile, sFileName + IntToStr(iX) + '.dat');
     ReWrite(outFile, 1);
     Inc(iX);
     BlockRead(InFile, CopyBuffer^, ChunkSize, iRecsOk);
     BlockWrite(OutFile, CopyBuffer^, iRecsOk, iRecWr);
     CloseFile(OutFile);
   Until (iRecOk < ChunkSize);
   CloseFile(inFile);
   FREEMEM(CopyBuffer, ChunkSize);
End;

SU^

COMPATTARE UN DATABASE ACCESS

Compattare il database da Delphi senza dover utilizzare Access (e senza nemmeno il bisogno di installarlo sulla macchina) è una procedura molto utile per chi si occupa di programmi gestionali con il diffuso DBMS di Microsoft.
Per risolvere questo problema bisogna appoggiarsi ad un'istanza dell'oggetto COM del provider Microsoft Jet. Nel codice si possono osservare i passi da compiere per compattare il database "C:\prova.mdb".

Uses ComObj;

Procedure CompactDatabase;
Var MsJet: Variant;
Begin
  MsJet := CreateOleObject('JRO.JetEngine');
  MsJet.CompactDatabase('Data Source=C:\prova.mdb;','Data Source=C:\provabak.mdb;');
  DeleteFile('C:\prova.mdb');
  RenameFile('C:\provabak.mdb', 'C:\prova.mdb');
End;

Per creare l'oggetto COM del provider Microsoft Jet è necessario includere la unit ComObj.

SU^

CONTROLLARE LA PRESENZA DI UN FLOPPY

Controlla la presenza di un media removibile in una unità come floppy o Iomega.

Function DiskReady(const Drive: char): Boolean;
Var DrvNum: byte;
       EMode: Word;
Begin
  result := false;
  DrvNum := ord(Drive);
  If DrvNum >= ord('a') Then dec(DrvNum,32);
  EMode := SetErrorMode(SEM_FAILCRITICALERRORS);
  Try
    If DiskSize(DrvNum-$40) <> -1 Then result := true
  finally
    SetErrorMode(EMode);
  End;
End;

SU^

CERCARE UN FILE

Questa function cerca un file di nome "name" partendo dalla posizione "initialpath"

Function findafile(initialpath,name:string):string;
Var s:Tsearchrec;
Begin
  If initialpath[length(initialpath)]<>'\ Tthen initialpath:=initialpath+'\';
  If findfirst(initialpath+name,faanyfile,s)=0 Then
    Begin
      findclose(s);
      result:=initialpath+name;
   End
  Else
   Begin
    If findfirst(initialpath+'*.*',faDirectory,s)=0 Then
      repeat
       If (( s.attr and faDirectory ) = faDirectory)and(s.name[1]<>'.') then
         result:=findafile(initialpath+s.name,name);
      Until (findnext(s)<>0)or(result<>'');
    findclose(s);
  End;
End;

SU^

CREARE UN PERCORSO

Questa procedura crea un percorso directory per subdirectory

Procedure forceMKDIR(path:string);
Bar c,d:integer;
Begin
  c:=pos('\',path)+1;
  If (path[length(path)]<>'\')and(pos('.',path)=0) then path:=path+'\';
  If pos('\',path)=1 Then
    Begin
     If path[2]='\' Then c:=3 // caso della rete \\ prova\ ciao
                           Else c:=2; // caso che manca la lettera \prova\ciao
    End;
   If upcase(path[1])in['A'..'Z'] Then c:=4; // caso normale c:\prova\ciao
   For d:=c to length(path) Do
      If (path[d]='\')and(not directoryexists(copy(path,1,d-1))) Then mkdir(copy(path,1,d-1));
End;

SU^

CONVERSIONE NUMERICA

Conversione numerica con punti delle migliaia e virgola decimale

Function point(s:string;separator:char):string;
Var c:integer;
Begin
  While pos(#32,s)<>0 Do  delete(s,pos(#32,s),1);
  If s='' Then exit;
   c:=pos('.',s);
  If c=0 then c:=length(s)+1;
  While c>0 Do
    Begin
     dec(c,3);
     insert(separator,s,c);
    End;
  While (length(s)>0)and(s[1]=separator) Do delete(s,1,1);
   result:=s;
End;

SU^

CREARE UNA BITMAP DA UN'ICONA

Procedure TForm1.Button1Click(Sender: TObject);
Var TheIcon : TIcon;
       TheBitmap : TBitmap;
Begin
  TheIcon := TIcon.Create;
  TheIcon.LoadFromFile('C:\Icons\Icona.ico');
  TheBitmap := TBitmap.Create;
  TheBitmap.Height := TheIcon.Height;
   TheBitmap.Width := TheIcon.Width;
   TheBitmap.Canvas.Draw(0, 0, TheIcon);
    Form1.Canvas.Draw(10, 10, TheBitmap);
    TheBitmap.Free;
    TheIcon.Free;
End;

SU^

INDIVIDUARE IL S.O. IN USO

La funzione che segue individua il tipo di S.O. in uso e la versione.

Function InfoSO: String;
Var piattaforma: string;
       win_ver: integer;
Begin
 Case (Win32Platform) of VER_PLATFORM_WIN32_WINDOWS:

  Begin
    piattaforma := 'Windows 9x/Me';
    win_ver := Win32BuildNumber AND $0000FFFF;
 End;
 VER_PLATFORM_WIN32_NT:

   Begin
    piattaforma := 'Windows NT';
    win_ver := Win32BuildNumber;
   End;
 Else

  Begin
   piattaforma := 'Windows';
   win_ver := 0;
  End;
 End; // case
If (Win32CSDVersion = '') Then
    InfoSO := Format('%s %d.%d (Build %d)', [piattaforma,Win32MajorVersion,

                                 Win32MinorVersion,win_ver])
 Else
    InfoSO := Format('%s %d.%d (Build %d: %s)', [piattaforma,Win32MajorVersion,
                               Win32MinorVersion,win_ver,WIN32CSDVersion]);
End;

SU^

DIMENSIONE DI UNA DIRECTORY

Fornisce l'esatta dimensione in byte del contenuto di una directory e delle sue sotto directory, potendo selezionare tramite caratteri jolly solo l'analisi di certi files e permettendo di scegliere se deve procedere anche nelle sottodirectory.

Function directorysize(path:string; var totfiles : integer):int64;
var s:Tsearchrec;
      t:integer;
Begin
  result:=0;
  t:=0;
  If path[length(path)]<>'\' Then path:=path+'\';
  If findfirst(path+'*.*',faanyfile,s)=0 Then
  repeat
    If s.name[1]<>'.' then

     Begin
      If ( s.attr and ( FaVolumeID + FaDirectory ) ) = 0 then

       Begin
          inc(result,s.Size);
          inc(totfiles);
       End;
     If ( s.attr and faDirectory ) = faDirectory Then
      Begin
         inc(result,directorysize(path+s.name+'\',t));
        inc(totfiles,t);
      End;
   End;
  until findnext(s)<>0;
  findclose(s);
End;

SU^

REFRESH DEL MONITOR

Questa procedura, collegata all'evento Click di un bottone permette di effettuare il refresh del desktop.

SendMessage(FindWindow('Progman', 'Program Manager'), WM_COMMAND, $A065, 0);

SU^

NUMERO DI COLORI SUPPORTATI

La funzione qui riportata consente di sapere il numero colori chee la risoluzione corrente riesce a
supportare, usando la funzione standart delle API GetDeviceCaps.

Function GetColor: Integer
Var h: hDC;
Begin
 Result := 0;
 try
  h := GetDC(0);
  Result := 1 shl (GetDeviceCaps(h,PLANES) * GetDeviceCaps(h, BITSPIXEL));
 finally
  ReleaseDC(0,h)
 End;
End;

SU^

NASCONDERE LE ICONE DEL DESKTOP

Ecco come nascondere tutte le icone presenti sul desktop di Windows.

Procedure ShowDesktop(const YesNo: boolean);
Var h: THandle;
Begin
  h := FindWindow('Progman', NIL);
  h := GetWindow(h, GW_CHILD);
  If (YesNo = TRUE) Then  ShowWindow(h, SW_SHOW);
                                     Else ShowWindow(h, SW_HIDE);
End;

Utilizzo:

Nascondi icone: ShowDesktop(FALSE);
Mostra icone: ShowDesktop(TRUE);
 

SU^

LISTA DEI PREFERITI DI IE

Richiamando la funzione GetIEFavorites verranno inseriti in una ListBox le voci presenti nel menù Preferiti del noto browser della software house di Redmond.

Function GetIEFavorites (const bm_path : string): TStrings;
Var s_rec : TSearchRec;
      str : TStrings;
     path, dir, filename : string;
     buffer : Array[0..2047] of char;
     found : integer;
Begin
 str := TStringList.Create;
 Try
   path := bm_path + '\*.url';
   dir := ExtrachFilePath(path);
   found := FindFirst(path, faAnyFile, s_rec);
   While (found = 0) Do

    Begin
      SetString(filename, buffer, GetPrivateProfileString('InternetSC',  PChar('URL'), NIL, buffer,

                       SizeOf(buffer), PChar(dir+s_rec.Name)));
      str.Add(filename);
      found := FindNext(s_rec);
    End; { while }
  found := FindFirst(dir+'\*.*', faAnyFile, s_rec);
  While (found = 0) Do

   Begin
     If ((s_rec.Attr AND faDirectory) > 0) AND (s_rec.Name[1] <> '.')) Then
          str.AddStrings(GetIE_BM(dir+'\'+s_rec.Name));
     Found := FindNext(s_rec);
   End; { while }
  FindClose(s_rec);
 finally
   result := str;
 End; {try-finally }
End;

{ Ecco come usarla }

Procedure TForm1.Button1Click(Sender: TObject);
Var pidl: PItemIDList;
      bm_path : Array[0..MAX_PATH] of char;
Begin
 SHGetSpecialFolderLocation(Handle, CSIDL_FAVORITES, pidl);
 SHGetPathFromIDList(pidl, bm_path);
 ListBox1.Items := GetIEFavorites(StrPas(bm_path));
End;

SU^

INDIRIZZO PORTA PARALLELA (LPT)

Questa funzione implementa una routine assembler che restituisce l'indirizzo hardware della porta LPT,
solitamente usata per la connessione ad una stampante.

Function GetPortAddress(PortNo:Integer):word; assembler; stdcall;
Asm
 push es
 push ebx
 mov ebx, PortNo
 shl ebx, 1
 mov ax,40h // Segmento dell'indirizzo
 mov es,ax
 mov ax,ES:[ebx+6]
 pop ebx
 pop es
End;

SU^

USARE I FILE INI

Molte volte i programmi hanno bisogno di salvare alcune informazioni in un file per poterle poi rileggere all'avvio successivo. Un metodo comodo per fare ciò è usare i file INI. Delphi mette a disposizione la classe TIniFile per la gestione automatica di tali file.
 

uses IniFiles;

Procedure CaricaDalFile;
Var FileIni: TIniFile;
Begin
 FileIni := TIniFile.Create('C:\Il_Mio_File.ini');
 try
  If FileIni.ReadBool('Sezione', 'Entry', false) Then FileIni.WriteString('Sezione2', 'Entry2', 'Valore2')
                                                                             Else FileIni.WriteString('Sezione2', 'Entry2', 'Valore1');
  FileIni.UpdateFile;
 finally
   FileIni.Free;
 End;
End;

Notiamo che la prima cosa da fare è creare un oggetto di tipo TIniFile passandogli come parametro il percorso del file. A questo punto abbiamo a disposizione vari metodi per leggere e scrivere stringhe, interi, booleani, etc. Questi metodi sono caratterizzati da tre parametri: il primo si riferisce ad una sezione del file (ad esempio "Opzioni generali"), il secondo richiama il nome del campo sul quale vogliamo fare l'operazione (ad esempio "Data Ultima esecuzione"). Infine il terzo parametro ha due scopi diversi: se stiamo andando a scrivere, il terzo parametro sarà il dato memorizzato; se invece stiamo leggendo questo sarà il valore che sarà restituito come valore predefinito nel caso che il file non contenesse la sezione o/e il campo che stiamo cercando di leggere. Una volta finite tutte le operazioni di scrittura è necessario eseguire il metodo "UpdateFile", altrimenti il file non sarà modificato.

SU^

IMPOSTARE LA RISOLUZIONE DEL MONITOR

In alcuni casi può essere utile impostare la risoluzione del monitor "al volo".
Come accade spesso, occorre utilizzare un'API di Windows: ChangeDisplaySettings.
La definizione della funzione è la seguente:

LONG ChangeDisplaySettings(LPDEVMODE lpDevMode, DWORD dwflags );

E' possibile utilizzarla anche per controllare se una particolare modalità è supportata dalla scheda video. Per una descrizione completa consultare il file di Help "Windows SDK"fornito con Delphi.
Il listato seguente illustra l'utilizzo dell'API.

Function SetMonitorRes(ResX, ResY, BxPix, Freq: Integer; ChangeMode: String): Boolean;
Var Mode: TDeviceMode; // Struttura con le nuove impostazioni
       Flags: DWORD; // Tipo d'impostazione: Test / Permanente
Begin
 // Preparo la struttura
 With Mode Do
  Begin
   dmSize := SizeOf(Mode);
   dmPelsWidth := ResX;
   dmPelsHeight := ResY;
   dmBitsPerPel := BxPix;
   dmDisplayFrequency := Freq;
   dmFields := DM_PELSWIDTH Or DM_PELSHEIGHT Or
   DM_BITSPERPEL Or DM_DISPLAYFREQUENCY;
 End;
 // Imposta la modalità
 Flags := 0;
 If ChangeMode = 'TEST' Then Flags := CDS_TEST
                                              Else If ChangeMode = 'REG' Then Flags := CDS_UPDATEREGISTRY;
 // Eseguo la chiamata: Restituisco True se la chiamata ha successo
 Result := (ChangeDisplaySettings(Mode, Flags) = DISP_CHANGE_SUCCESSFUL);
End;
 

SU^

APRIRE E CHIUDERE IL LETTORE CD

Create una nuova applicazione ed includete in essa la unit "MMSystem"

uses MMSystem;

Ora per aprire il lettore cd usate il comando :

mciSendString('Set cdaudio door open wait', nil, 0, handle);

mentre per chiudere il lettore cd usate il comando :

mciSendString('Set cdaudio door closed wait', nil, 0, handle);

SU^

SPEGNERE ED ACCENDERE IL MONITOR

Per spegnere il monitor usate il comando :

SendMessage(Application.Handle, WM_SYSCOMMAND, SC_MONITORPOWER, 0);

mentre per accendere il monitor usate il comando :

SendMessage(Application.Handle, WM_SYSCOMMAND,SC_MONITORPOWER, -1);

SU^

HINT SU PIU' RIGHE

Nell' evento FormCreate della form contenente ad esempio il Button1aggiungete la seguente linea :

Button1.Hint := 'Prima riga' + Chr(13) + 'Seconda riga' + Chr(13) +'...';

SU^

COLORARE LE CELLE DI UNA DBGRID

Creiamo una nuova applicazione ed utilizziamo i seguenti componenti :  Table1, DataSource1,
DBGrid1 ed eseguiamo le seguenti operazioni : poniamo la proprietà DatabaseName del componente Table1 uguale a DBDEMOS, poniamo la proprietà TableName del componente Table1 uguale a
animals.dbf, poniamo la proprietà Active del componente Table1 uguale a True, poniamo la proprietà DataSet del componente DataSource1 uguale a Table1, poniamo la proprietà DataSource del componente DBGrid1 uguale a DataSource1, ora facciamo doppio click nella casella a lato dell'evento
OnDrawColumnCell del componente DBGrid1 creando così l'evento DBGrid1DrawColumnCell, quindi andiamo a scrivere le seguenti linee di codice :

Procedure TForm1.DBGrid1DrawColumnCell(Sender: TObject; const Rect: TRect;
                                                                    DataCol: Integer; Column: TColumn; State: TGridDrawState);
Begin
 If ((State = [gdSelected,gdFocused]) or (State = [gdSelected])) and

     (Table1.FieldByName('SIZE').AsString = '10')  Then
    {Se la cella è selezionata ed il valore della cella SIZE è 10 allora ...}
    Begin
     If Column.FieldName = 'AREA' Then
       Begin
        DBGrid1.Canvas.Brush.Color := clRed; {imposta il rosso come sfondo}
        DBGrid1.Canvas.Font.Color := clWhite; {imposta il bianco come colore del font}
        DBGrid1.Canvas.FillRect(Rect); {colora lo sfondo di rosso}
        DBGrid1.Canvas.TextOut(Rect.Left+2, Rect.Top+2,

                       Table1.FieldByName(Column.FieldName).AsString); {scrive il testo di colore bianco}
      End;
    End

  Else
  If (Table1.FieldByName('SIZE').AsString = '10') Then
    {altrimenti se il valore della cella SIZE 10 allora ...}
   Begin
    If Column.FieldName = 'AREA' Then
     Begin
       DBGrid1.Canvas.Brush.Color := clMaroon; {imposta il bordeaux come sfondo}
       DBGrid1.Canvas.Font.Color := clGray; {imposta il grigio come colore del font}
       DBGrid1.Canvas.FillRect(Rect); {colora lo sfondo di bordeaux}
       DBGrid1.Canvas.TextOut(Rect.Left+2, Rect.Top+2,

                         Table1.FieldByName(Column.FieldName).AsString); {scrive il testo di colore grigio}
    End;
 End;
End;

Con questa procedura si è impostato il colore di sfondo e del testo del campo AREA in modo differente da tutta la griglia nel caso in cui il campo SIZE del record corrispondente è uguale a 10.

SU^

ULTIMO GIORNO DEL MESE

Creiamo una nuova applicazione ed utilizziamo i seguenti componenti : DateTimePicker1, Edit1
Facciamo ora doppio click nella casella a lato dell'evento OnChange del componente DateTimePicker1 creando così l'evento DateTimePicker1Change, quindi andiamo a scrivere le seguenti linee di codice :
 

Procedure TForm1.DateTimePicker1Change(Sender: TObject);
Var  Data : TDate;
        Anno, Mese, Giorno : Word;
Begin
 Data:= DateTimePicker1.Date;
 DecodeDate(Data, Anno, Mese, Giorno);
 If Mese = 12 Then
   Begin
    Mese := 1;
    Anno := Anno + 1;
   End

  Else
   Begin
     Mese := Mese + 1;
   End;
 Giorno := 1;
 Data := EncodeDate(Anno, Mese, Giorno);
 Data := Data - 1.0;
 Edit1.Text := DateToStr(Data);
End;

SU^

CANCELLARE UNA DIRECTORY

Qquesta funzione cancella la directory "path" e le sub-directory result=true se tutto Ok

Function deltree ( path : string ):boolean;
Var s:Tsearchrec;
Begin
 If path[length(path)]<>'\ Tthen path:=path+'\';
 If findfirst(path+'*.*',faanyfile,s)=0 Then
   repeat
    If (( s.attr and ( FaVolumeID + FaDirectory ) ) = 0) and (s.name[1]<>'.') Then deletefile(path+s.name);
    If (( s.attr and faDirectory ) = faDirectory)and(s.name[1]<>'.') then
     Begin
      deltree(path+s.name);
      RemoveDirectory(pchar(path+s.name));
     End;
   Until findnext(s)<>0;
 findclose(s);
 result:=removeDirectory(pchar(path));
End;

SU^

FINDCOMPONENT

Supponiamo di dover porre la proprietà Text di 20 componenti TEdit della Form1 uguale alla stringa nulla. Si potrebbero scrivere le seguenti 20 linee di codice :

Edit1.Text := '';
Edit2.Text := '';
...
Edit20.Text := '';

Tuttavia la funzione FindComponet ( TComponent.FindComponent ) ci permette di scrivere meno codice e di velocizzare eventuali operazioni di modifica.
Per quanto riguarda l'esempio precedente, possiamo sintetizzare le linee di codice nel seguente modo :

For I := 1 to 20 Do
Begin
 TEdit(Form1.FindComponent('Edit'+IntToStr(I))).Text := '';
End;
 

SU^

ESEGUIRE UNA APPLICAZIONE DA UN PROGRAMMA

Esiste un api di windows : shellExecute
 

Procedure TForm1.Button1Click(Sender: TObject);
Var lsprocess : string;
       lsCommandLine : string;
Begin
 lscommandline := '';
 lsprocess := 'd:\Nomeile.exe;
 shellExecute(Form1.Handle,'open',pchar(lsprocess),pchar(lscommandline),nil,sw_Hide);
End;

If WinExec( 'C:\Programmi\haead\nero.exe', WM_SHOW ) > 31 Then showmessage (' APERTO !!!!');

SU^

ESEGUIRE WORD O EXCEL DA UN PROGRAMMA

Esiste  il modo di creare un programma che lanci Word o Excel

FExcel e un variant.
// Creo L' oggetto OLE di tipo Excel
FExcel := Unassigned;
FExcel := CreateOleObject('Excel.Application');
Fexcel.Visible := True;
FExcel.Workbooks.Add;

SU^

EFFETTUARE IL REBOOT DEL COMPUTER

Il reboot del computer è un evento abbastanza frequente nei programmi di installazione, per esempio dopo la modifica dei parametri del registro di configurazione.
Per effettuare il reboot della macchina è sufficiente invocare la funzione API ExitWindowsEx. Questa funzione viene chiamata anche dallo stesso Windows quando deve effettuare altre operazioni connesse alla chiusura del sistema operativo, per esempio la disconnessione dell'utente o lo spegnimento della macchina.

Per riavviare il computer è sufficiente effettuare questa chiamata:

ExitWindowsEx(EWX_REBOOT, 0);

EWX_REBOOT è una costante che identifica il modo con cui si esce da Windows. Specificando altre costanti è possibile compiere le altre operazioni connesse alla chiusura di Windows.
 

SU^

LEGGERE IL NUMERO SERIALE DI UN DISCO

Uno dei problemi più frequenti per i programmatori è la protezione del software. Il controllo più semplice da realizzare si basa sulla generazione di una chiave univoca di registrazione in base al numero seriale del disco. Qui di seguito illustriamo come ottenere il numero seriale di un disco qualsiasi (A, B, C, D e così via).

Function SerialNumber(const DriveLetter: Char): string;
Var NotUsed: DWord;
       VolumeFlags: DWord;
       VolumeInfo: array [0..MAX_PATH] of Char;
       VolumeSerialNumber: DWord;
Begin
 GetVolumeInformation(PChar(DriveLetter + ':\'), VolumeInfo, SizeOf(VolumeInfo),
                                         @VolumeSerialNumber, NotUsed, VolumeFlags, nil, 0);
 Result := Format('Label = %s VolSer = %8.8X',[VolumeInfo, VolumeSerialNumber])
End;

SU^

LEGGERE LE INFORMAZIONI DI UN FILE MP3

Per chi di voi volesse programmare un bel clone di WinAmp o affini qui di seguito illustreremo come è possibile, con poche righe di codice, ottenere varie informazioni su un file MP3.
Le informazioni contenute nell'ID3-Tag dei file MP3 sono organizzate nel seguente modo:

Byte 1-3 = ID 'TAG'
Byte 4-33 = Titolo
Byte 34-63 = Artista
Byte 64-93 = Album
Byte 94-97 = Anno
Byte 98-127 = Commento
Byte 128 = Genere

Impostiamo quindi una semplice struttura dati dove caricare le informazioni:

Type Mp3Info = record
        ID: string[3];
        Titolo: string[30];
        Artista: string[30];
        Album: string[30];
       Anno: string[4];
       Commento: string[30];
       Genere: Byte;
End;

implementation

Function Mp3GetInfo(NomeFile: String): Mp3Info;
Var FS: TFileStream;
       Buffer:array [1..128] of Char;
Begin
 FS := TFileStream.Create(NomeFile, fmOpenRead or fmShareDenyWrite);
 Try
   FS.Seek(128, soFromEnd);
   FS.Read(Buffer, 128);
   With Result Do

    Begin
     ID := Copy(Buffer, 1, 3);
     Titolo := Copy(Buffer, 4, 30);
     Artista := Copy(Buffer, 34, 30);
     Album := Copy(Buffer, 64, 30);
     Anno := Copy(Buffer, 94, 4);
     Commento := Copy(Buffer, 98, 30);
     Genere := Ord(Buffer[128]);
    End;
 Finally
   FS.Free;
 End;
End;

Per esempio, il risultato della funzione Mp3GetInfo è accessibile nel seguente modo:

Procedure TmyForm.MyButtonClick(Sender: TObject);
Var MyMp3Info: Mp3Info;
Begin
// supponendo di avere 7 label su MyForm che chiameremo lblAutore, lblTitolo, etc.
MyMp3Info := Mp3GetInfo('c:\mymusic\canzone.mp3');
lblAutore.Caption := MyMp3Info.Artista;
lblAlbum.Caption := MyMp3Info.Album;
// ...e così via per tutte le informazioni che vi servono!
End;

SU^

CATTURARE LO SCHERMO IN UNA FORM

Procedure TScrnForm.Cattura;
Var DesktopDC : HDC;
       DesktopCanvas: TCanvas;
       Desktoprect : TRect;
Begin
 DesktopDC := GetWindowDC(getdesktopwindow);
 DesktopCanvas := TCanvas.Create;
 DesktopCanvas.Handle := DesktopDC;
 DesktopRect := Rect(0,0,screen.width, screen.height);
 Canvas.CopyRect(desktopRect, desktopCanvas, DesktopRect);
 ReleaseDC(getdesktopwindow, DesktopDC);
End;

E' possibile applicare una variante, cioè invece di usare il canvas della form, si potrebbe utilizzare un TImage per salvare lo schermo catturato in formato immagine.

SU^

CAMBIARE PROPRIETA' COMUNI

Con questa semplice procedura si può cambiare il colore di tutti i componenti della famiglia TEdit presenti sul form. Ovviamente questo metodo può essere applicato a tutti i tipi di componenti e a tutte le proprietà.
 

Procedure TForm1.SetEditsColor(Colore : TColor);
Var i: integer;
Begin
 For i := 0 to (ComponentCount - 1) Do

   Iif (components[i] is TEdit) Then TEdit(Components[i]).Color := Colore;
End;

SU^

SPOSTARE UN FILE

Per spostare uno o più files da una parte ad un'altra dello stesso disco, basta rinominare il file:

Esempio: RenameFile('C:\Programmi\App.exe', 'C:\DelphiApps\App.exe');

SU^

AVVIO DI UN APPLICAZIONE ALL'AVVIO DI WINDOWS

Una semplice, ma utilissima, procedura che operando sul Registro di Sistema permette di avviare il vostro applicativo all'avvio di Windows
 

Procedure Avvio(TitoloPrg,LineaComando: String; aRunOnce: Boolean);
Var  hKey: string;
        hReg: TRegIniFile;
Begin
 If (aRunOnce) Then hKey := 'Once'
                           Else hKey := '';
 hReg := TRegIniFile.Create('');
 hReg.RootKey := HKEY_LOCAL_MACHINE;
 hReg.WriteString('Software\Microsoft\Windows\CurrenteVersion\Run'+hKey+#0,

                                 TitoloPrg, LineaComando);
 hReg.Destroy;
End;

SU^

INDIRIZZO IP
Volete sapere il vostro indirizzo IP?

Uses WinSock, SysUtils;

Function GetIp: string;
Type p_ulong = ^u_long;
Var v_TWSAData : TWSAData;
      v_PHostEnt : PHostEnt;
      v_TInAddr : TInAddr;
      buffer : Array[0..255] of char;
      fd, rc : integer;
Begin
 result :='';
 rc := WSAStartup($101,v_TWSAData);
 If (rc <> 0) Then raise EsockUtilErr.CreateFmt('Errore (Startup di WSA): %d',[rc])
                    Else

                     Begin
                      GetHostName(buffer, sizeof(buffer));
                      v_PHostEnt := GetHostbyName(buffer);
                      v_TinAddr.S_addr := u_long(p_ulong(v_PHostEnt^.h_addr_list^)^);
                      result := inet_ntoa(v_TInAddr);
                    End;
 fd := WinSock.Socket(PF_INET, SOCK_STREAM, 0);
 If (fd = INVALID_SOCKET) Then
     raise EsockUtilErr.CreateFmt('%d %d: Socket non valido',[fd, WSAGetLastError]);
 SWACleanup;
End;

SU^

CONFRONTO DATE

Ecco un modo molto semplice di confrontare due date usando la funzione EncodeDate di Delphi.
 

uses SysUtils;
if (Date > EncodeDate(2002, 12, 15)) then ShowMessage("Buon Compleanno Daemon2k");

SU^

DISABILITARE BEEP DI SISTEMA

Attraverso la funzione SystemParametersInfo potete disabilitare/abilitare il beep di sistema.

{ Disabilita } SystemParametersInfo(SPI_SETBEEP, 0, NIL, SPIF_SENDWININICHANGE);
{ Abilita } SystemParametersInfo(SPI_SETBEEP, 1, NIL, SPIF_SENDWININICHANGE);

SU^

CURSORI E ICONE

Spesso si desidera utilizzare per il cursore un disegno particolare appropriato per le circostanze in corso. Per fare questo si devono eseguire i seguenti passi:

disegnare un cursore (particolare bitmap 32x32 pixels), se non lo si ha già disposizione, ed eventualmente definirne l’Hotspot;
creare un file di risorse contenente il cursore desiderato;

includere il file di risorse nell’applicativo (usando la direttiva {$R nomefile di risorse});

aggiungere l’handle del cursore nell’elenco dei cursori (Screen.Cursors) usando l’API LoadCursor: Cursors è un’array di handle e all’inizio contiene i cursori forniti di default da Delphi, pertanto è bene che andiate ad inserire il vostro cursore in una casella vuota (lo sono tutte quelle con indice positivo).
A questo punto ogni qual volta durante l’esecuzione vogliate utilizzare il cursore non dovrete far altro che:

Screen.Cursor := indice del vostro cursore;

Esempio: dato un file Curs.Res contenente il cursore chiamato MioCurs, dovete inserire in uno dei file della vostra applicazione la direttiva:

{$R Curs.Res}

ipotizzando che il file risorse si trovi nella stessa directory del codice. Poi dovete caricare il cursore nella tabella supponiamo nella 3a cella:

Screen.Cursors[3] := LoadCursor(HInstance, ‘MIOCURS’);

Infine quando si vuole mostrare questo cursore si farà:

Screen.Cursor := 3;
 

SU^

COME RENDERE TRASPARENTE UN COMPONENTE DERIVATO DA TCustomControl

TCustomControl è la classe per ogni nuovo componente custom in Delphi. Alcune tra le caratteristiche che la contraddistinguono dagli altri discendenti di TWinControl sono:
- disporre di un proprio Device Contect (non solo la Canvas del contenitore);
- contenere altri controlli.
Il supporto di un prorprio Device Context rende impossibile la creazione di nuovi controlli/containers con il background trasparente, al contrario dei più "leggeri" TGraphicControl che sfruttano la Canvas del parent. In realtà, sotto Win32, è possibile rimediare a questa situazione di fatto, semplicemente settando la proprietà WS_EX_TANSPARENT della finestra associato al controllo.
Per far questo ci vengono in aiuto le API Win32 GetWindowLong() e SetWindowsLong(), dichiarate nel seguente modo:
function GetWindowLong(hWnd:HWND; nIndex: Integer): Longint; stdcall;
function SetWindowLong(hWnd: HWNDM; nIndex:Interger;dwNewLong:Longint):Longint;stdcall;
Entrambe necessitano dell'handle della finestra da gestire e l'offset del gruppo di proprietà da gestire (controllare l'SDK). GetWindowLong() restituisce il valore della proprietà richiesta, mentre la sua reciproca necessità di un ulteriore parametro (dwNewLong) che conterrà il valore da settare.- Ecco come dovrebbero essere usate:
Procedure TMyCustomControl.SetTrasparent(Trans_mode : boolean);
Var WinMode : Integer;
Begin
// Leggiamo gli attributi della finestra
winMode:=GetWindowLong(handle, GWL_EXSTYLE);
if trans_mode
then winMode:=winMode or WS_EX_TRANSPARENT
else winMode:= winMode and (not WS_EX_TRANSPARENT);
// Reimpostiamo il tutto...
SetWindowLong(handle, GWL_EXSTYLE, winMode);
End;

SU^

COME NASCONDRE UN TASK

Com’è possibile nascondere il nome di un’applicazione al task manager?

In che modo posso evitare che, alla pressione del tasto CTRL + ALT + CANC, si veda il nome di un programma?

 Come faccio ad associare una estensione al mio programma?
 

La funzione da usare per simulare il comportamento di un Servizio sotto Windows95 è RegisterServiceProcess(). Per poter usare questa API è necessario dichiararla staticamente nel seguente modo:

Unit XXX;
Interface
....
const
 // Register Service Process Flags
 RSP_SIMPLE_SERVICE = $00000001;
 RSP_UNREGISTER_SERVICE = $00000000;
 Function RegisterServiceProcess( ProcessID, OpTypeFlag : DWORD ) : DWORD; stdcall;
implementation
....
 Function RegisterServiceProcess; external kernel32 name
 'RegisterServiceProcess';
 

In alternativa si può sfruttare il caricamento dinamico con il seguente codice:

Ttype TMyFunction = function( ProcessID, OpTypeFlag : DWORD ) : DWORD; stdcall;
Var RegisterServiceProcess: TMyFunction;
Begin
@RegisterServiceProcess :=GetProcAddress(GetModuleHandle('KERNEL32.DLL'),'RegisterServiceProcess');

Con a disposizione questa chiamata, il codice seguente disabilita la visualizzazione dell'applicativo corrente nel Task-Manager:

RegisterServiceProcess(0, RSP_SIMPLE_SERVICE);

da notare come il Process ID passato sia '0', che indica il processo corrente. Per ripristinare la situazione iniziale si deve usare la chiamata:

RegisterServiceProcess(0, RSP_UNREGISTER_SERVICE);

C'è da dire che questo sistema fa molto più che inibire o meno la visualizzazione nel Task-Manager: infatti, queste chiamate rientrano nell'insieme di funzionalità denominate "Windows 95 Service Control Manager". Per un approfondimento sull'argomento il consiglio è di controllare ladocumentazione dell'SDK.

Per ciò che riguarda il secondo problema, vediamo cosa occorre fare per registrare un estensione e far si che l’Explorer di Windows possa assegnare un'applicazione Container. Questo garantisce che il tuo programma sarà attivato ad ogni richiesta di apertura del documento con l'estensione desiderata. Per ottenere questo risultato è necessario eseguire questi passi:

Creare una chiave nel registry del tipo HKEY_CLASSES_ROOT\MY_APP_ID, dove MY_APP_ID è un identificativo che dobbiamo assegnare arbitrariamente alla nostra applicazione container;

Come valore di default della chiave, è bene assegnare una stringa contenente una descrizione dell'estensione. Quest’informazione, ad esempio, apparirà nella dialog Proprietà sotto la voce Tipo di File;

Se di desidera assegnare un'icona standard all'estensione, aggiungere la sotto chiave HKEY_CLASSES_ROOT\MY_APP_ID\DefaultIcon e assegnare come valore una stringa contenente il percorso del file con l'icona.

Designare le operazione eseguibili dalla Shell di Explorer. Di norma questo equivale a creare un'ulteriore sotto-chiave sotto \MY_APP_ID\Shell\ e qui assegnare le azioni da intraprendere in caso di apertura \Open, stampa \Print o modifica \Edit del documento. Ad esempio, per gestire l'apertura creeremo la chiave HKEY_CLASSES_ROOT\MY_APP_ID\Shell\Open\Command e qui assegneremo il valore stringa E:\MyPath\MyApp.exe "%1";

L'ultimo passo consiste nel creare una chiave con il nome della nostra estensione nel ramo HK_CLS_Root, ad esempio HKEY_CLASSES_ROOT\.MyExt, e assegnare come valore predefinito una stringa con l'App_id del container.

SU^

REGISTRAZIONE AUTOMATICO DEL BDE

Spesso è auspicabile installare in rete un applicativo Delphi, senza dover effettuare alcuna installazione sui vari client.Ciò può essere fatto senza problemi se l'applicativo non accede ad alcun database. Quantunque, se ciò dovesse avverarsi, è possibile installare una copia del BDE in una directory condivisa sul server (per esempio in \\SERVER\BDE), ed inserire PRIMA della inizializzazione dell'applicazione… il codice che permette di registrare, sulla macchina client, il BDE.Attenzione: la BDEPath deve contenere il path al BDE condiviso (al limite potrebbe essere "recuperata" da un file)

Program REGISTRABDE;
Uses Forms, controls, registry, windows, Unit1 in 'Unit1.pas' {Form1},
 

{$R *.RES}
Const BDEPath= '\\SERVER\BDE';
Var r:Tregistry;
 

Begin
 r:=TRegistry.Create;
 try
  r.RootKey:=HKEY_CLASSES_ROOT;
  If r.OpenKey('CLSID\{FB99D700-18B9-11D0-A4CF-00A024C91936}\InprocServer32',true) Then
   Begin
    r.WriteString('(DEFAULT)',BDEPath+'\IDSQL32.DLL');
     r.WriteString('ThreadingModel','Apartment');
   End;
  r.CloseKey;
  If r.OpenKey('CLSID\{FB99D710-18B9-11D0-A4CF-00A024C91936}\InprocServer32',true) Then
   Begin
    r.WriteString('(DEFAULT)',BDEPath+'\IDAPI32.DLL');
    r.WriteString('ThreadingModel','Apartment');
   End;
  r.CloseKey;
  r.RootKey:=HKEY_LOCAL_MACHINE;
  If r.OpenKey('SOFTWARE\Borland\BLW32',true) Then
   Begin
    r.WriteString('BLAPIPATH',BDEPath);
r.WriteString('LOCALE_LIB1',BDEPath+'\usa.bll');r.WriteString('LOCALE_LIB2',BDEPath'\europe.bll');
   r.WriteString('LOCALE_LIB3',BDEPath+'Other.bll');
   r.WriteString('LOCALE_LIB4',BDEPath+'\charset.bll');
   r.WriteString('LOCALE_LIB5',BDEPath+'\ceeurope.bll');
  End;
  r.CloseKey;
 If r.OpenKey('SOFTWARE\Borland\DataBase Enginè,true) Then
  Begin
   r.WriteString('CONFIGFILE01',BDEPath+'\IDAPI32.CFG');
   r.WriteString('DLLPATH',BDEPath);
  End;
 r.closeKey;
 finally
 r.free;
End;
application.initialize;

SU^

MODIFICARE LA FORMA DI UNA FINESTRA

L'API di Windows annovera una serie di funzioni molto utili. Una di queste è SetWindowRgn, grazie alla quale è possibile creare finestre d’ogni forma e dimensione, o meglio "ritagliare" il bordo di una finestra a nostro piacimento.
Eccone un esempio che permette di disegnare finestre "non" rettangolari.

Procedure TForm1.FormCreate(Sender: TObject);
Var R: HRgn;
       P: array [0..360] of TPoint;
       x, y, radius,  cx, cy, theta : integer;
Begin
 radius:=200; // raggio del cerchio
 cx:=300; // Coordinate del centro
 cy:=300;
 For theta:=0 To 360 Do

  Begin
   x := cx + round(radius * cos(theta));
   y := cy + round(radius * sin(theta));
   p[theta]:=point(x,y);
 End;
 R := CreatePolygonRgn (P , 360 , WINDING);
 // Crea una finestra rotonda
 SetWindowRgn(Form1.Handle, R , TRUE);
End;
 

SU^

CONTROLLO DELLA PORTA LPT1

Prima di iniziare la stampa di un documento, talvolta è utile verificare lo stato del dispositivo stampante al fine di segnalare a video eventuali problemi.
Una possibile tecnica utile per verificare eventuali anomalie, è usare l'interrupt 17h (servizio 2) del BIOS. Nel registro DH è necessario riportare il numero di "LPT" considerata (LPT1=0; LPT2=1, ecc.).
La seguente funzione è stata verificata in ambiente Windows 95.

Const
 PRT_FREE=128; // Stampante libera
 PRT_PAPEROUT=32; // Paper out
 PRT_SELECTED=16; // Selected
 PRT_OTHER=15; // Other error

Function ControllaStampante:Integer;
Var b:byte;
 Begin
  asm
  mov DX,0 // Stampante LPT1
  mov AH,2 // Servizio 2
  int 17H // IRQ BIOS 17
  mov b,AH
 End;
ControllaStampante:=b;
End;

SU^

IDENTIFICAZIONE DEL TIPO DI PIATTAFORMA Win32

Le differenze esistenti tra le diverse implementazioni del set di API WIN 32s, WIN 95, WIN NT risultato di fondamentale importanza nella programmazione di sistema, ed in tutti i casi in cui abbiamo bisogno di lavorare con i meccanismi di protezione/privilegi d'accesso propri di Windows NT e completamente assenti in Windows 95. A tal fine, dalla versione 2 di Delphi è presente la variabile di sistema "Win32Platform", che restituisce il tipo di piattaforma sulla quale l'applicazione è in esecuzione. La dichiarazione è la seguente( unit "sysUtil.pas"):
 

var Win32Platform: integer;

La variabile può assumere i seguenti valori:
VALORE                                                          SIGNIFICATO   NUMERO
VER_PLATFORM_WIN32s                         Win32s.                 0
VER_PLATFORM_WIN32_WINDOWS   Windows 95.        1
VER_PLATFORM_WIN32_NT                   Windows NT.      2

SU^