Page 1 of 3 1 2 3 LastLast
Results 1 to 15 of 39

Thread: Krijg memory leak niet gevonden

  1. #1
    Win32.Trojan.Heur.Herby
    Join Date
    Dec 2003
    Location
    Nuenen of all places
    Posts
    289

    Krijg memory leak niet gevonden

    Hoi

    Ik heb iets vreemd in een functie waar ik al dagen in aan het zoeken ben.

    In een functie (volledig gestrip met alleen het error gedeelte) vraag ik het volume label of drive mapping op.
    Doe ik dit voor alle 26 mogelijke driveletters los, dan gaat het prima, doe ik dit in een loop van 0..25 dan heb ik een memory leak.

    De standaard API's bieden geen functionaliteit voor drives die wel als driveletter in Windows aanwezig zijn maar op dat moment niet beschikbaar zijn (disconnected).
    In mijn situatie heb ik een netwerk media box die standaard uit staat, drive M: is dan wel aanwezig binnen Windows maar drive is disconnected.
    Windows laat dit zelf overigens wel goed zien.
    Name:  2023-01-22 09_32_46-Window.png
Views: 203
Size:  2.4 KB


    Ik hoop dat iemand me hiermee kan helpen want ik kom er niet uit (mijn debugging skills ontbreken bij deze een beetje )



    In de gestripte code bereik ik hetzelfde as wat Windows laat zien en kan opvragen wat de naam van drive M: is.

    Code:
    
    program TSTDiskInfoMemLeak;
    
    {$APPTYPE CONSOLE}
    
    {$R *.res}
    
    uses
      System.SysUtils,
      WinAPI.Windows,
      Winapi.ShellAPI;
    
    type
      TDiskSign                 = string[2];
      TDiskType                 = (dtUnknown, dtNotExists, dtRemovable, dtFixed, dtRemote, dtCDROM, dtRAMDisk, dtRemovableNotConnected);
    
      TDiskInfo                 = record
        DiskSign                : TDiskSign;
        DiskType                : TDiskType;
        VolumeLabel             : string;
        ImageIndex              : integer;
      end;
    
    function DiskTypeToStr (aDiskType: TDiskType) : string;
    begin
      case aDiskType of
        dtUnknown               : result := 'Unknown';
        dtNotExists             : result := 'Does''t exists';
        dtRemovable             : result := 'Removable';
        dtFixed                 : result := 'Fixed';
        dtRemote                : result := 'Remote';
        dtCDROM                 : result := 'CDrom';
        dtRAMDisk               : result := 'RAMdisk';
        dtRemovableNotConnected : result := 'Removable disconnected';
      end;
    end;
    
    function GetDiskInfo (aDiskSign : TDiskSign) : TDiskInfo;
    var
      lpnLength             : Cardinal;
      lError                : DWORD;
      lBufVolumeLabel       : PChar;
    begin
      Result.DiskSign       := aDiskSign;                                                                                   // TDiskInfo.Sign = Driveletter STRING[2]
      Result.DiskType       := dtUnknown;                                                                                   // Init
      Result.VolumeLabel    := '';                                                  					// Init
      Result.ImageIndex     := -1;                                                  					// Init
    
    
      case GetDriveType(PChar(IncludeTrailingPathDelimiter(string(aDiskSign)))) of               				// Check if drive removable, fixed, CD-ROM, RAM disk, or network drive.
        DRIVE_UNKNOWN       : Result.DiskType := dtUnknown;                        						// The drive type cannot be determined
        DRIVE_NO_ROOT_DIR   : Result.DiskType := dtNotExists;                      						// The root path is invalid. For example, no volume is mounted at the path.
        DRIVE_REMOVABLE     : Result.DiskType := dtRemovable;                      						// The disk can be removed from the drive.
        DRIVE_FIXED         : Result.DiskType := dtFixed;                          						// The disk cannot be removed from the drive
        DRIVE_REMOTE        : Result.DiskType := dtRemote;                         						// The drive is a remote (network) drive
        DRIVE_CDROM         : Result.DiskType := dtCDROM;                          						// The drive is a CD-ROM drive
        DRIVE_RAMDISK       : Result.DiskType := dtRAMDisk;                        						// The drive is a RAM disk
      end;
    
      if Result.DiskType = dtNotExists then                                                                                 // if NotExists then start checking for Disconnected drive
        begin
          lpnLength         := 0;                                                                                           // Init
    
          lError            := WNetGetConnection(PChar(aDiskSign), nil, lpnLength);              				// Get Size for lBufVolumeLabel in lpnLength
    
          if lError = ERROR_MORE_DATA then                                                                                  // size received in lpnLength
            begin
              lBufVolumeLabel := AllocMem(lpnLength);                                           				// Alloc memory for VolumeLabel buffer
              try
                lError := WNetGetConnection(PChar(aDiskSign), lBufVolumeLabel, lpnLength);       				// Get network name
                if lError = ERROR_CONNECTION_UNAVAIL then                                                                   // It exists but is unavailable
                  begin
                    Result.VolumeLabel := lBufVolumeLabel;      // <<<<<<<<<<<<<<<<<<< MEM LEAK                             // Return volume label
                    Result.DiskType := dtRemovableNotConnected;                                                             // Return DiskType
                    Result.ImageIndex := SIID_DRIVENETDISABLED;                                                             // Set imageindex to disconnected icon
                  end
                else
                  Result.DiskType := dtNotExists;                                                                           // otherwise reurn dtNotExists
              finally
                FreeMem(lBufVolumeLabel, lpnLength);                                                                        // Free Memory
              end;
            end;
        end;
    end;
    
    
    var
      lDiskInfo : TDiskInfo;
      I : byte;
    begin
      ReportMemoryleaksOnShutdown := true;
    
    
      try
        for I := 0 to 25 do                                                                                                 // Loop through all possible drives
    //  I := 12;                                                                                                            // or use one
          begin
            FillChar(lDiskInfo, SizeOf(lDiskInfo), #0);                                                                     // Clear the DiskInfo record
            lDiskInfo := GetDiskInfo (shortstring(Char(I + Ord('A'))+':'));                                                 // Driveletter
    
            WriteLn (format('I=%d    Drive=%s',[I,lDiskInfo.DiskSign] ));
            if lDiskInfo.DiskType <> dtNotExists then
              begin
                WriteLn(format('%-30s : %s',['DiskSign'     ,lDiskInfo.DiskSign]));
                WriteLn(format('%-30s : %s',['DiskType'     ,DiskTypeToStr(lDiskInfo.DiskType)]));
                WriteLn(format('%-30s : %s',['VolumeLabel'  ,lDiskInfo.VolumeLabel]));
                //WriteLn(format('%-30s : %d',['ImageIndex'   ,lDiskInfo.ImageIndex]));
                WriteLn('--------------------------------------------------------------------------------');
              end
            else
              WriteLn('--------------------------------------------------------------------------------');
          end;
    
    
    
      except
        on E: Exception do
          Writeln(E.ClassName, ': ', E.Message);
      end;
    
      readln;
    end.
    
    
    Draai ik dit 26x los, geen probleem, in een loop krijgt ik volgende error.

    Code:
    
    I=0    Drive=A:
    --------------------------------------------------------------------------------
    I=1    Drive=B:
    --------------------------------------------------------------------------------
    I=2    Drive=C:
    DiskSign                       : C:
    DiskType                       : Fixed
    VolumeLabel                    :
    --------------------------------------------------------------------------------
    I=3    Drive=D:
    DiskSign                       : D:
    DiskType                       : Fixed
    VolumeLabel                    :
    --------------------------------------------------------------------------------
    I=4    Drive=E:
    DiskSign                       : E:
    DiskType                       : Fixed
    VolumeLabel                    :
    --------------------------------------------------------------------------------
    I=5    Drive=F:
    DiskSign                       : F:
    DiskType                       : Removable
    VolumeLabel                    :
    --------------------------------------------------------------------------------
    I=6    Drive=G:
    --------------------------------------------------------------------------------
    I=7    Drive=H:
    --------------------------------------------------------------------------------
    I=8    Drive=I:
    --------------------------------------------------------------------------------
    I=9    Drive=J:
    --------------------------------------------------------------------------------
    I=10    Drive=K:
    --------------------------------------------------------------------------------
    I=11    Drive=L:
    --------------------------------------------------------------------------------
    I=12    Drive=M:
    DiskSign                       : M:
    DiskType                       : Removable disconnected
    VolumeLabel                    : \\192.168.0.240\Disk_sda1
    --------------------------------------------------------------------------------
    I=13    Drive=N:
    --------------------------------------------------------------------------------
    I=14    Drive=O:
    --------------------------------------------------------------------------------
    I=15    Drive=P:
    --------------------------------------------------------------------------------
    I=16    Drive=Q:
    --------------------------------------------------------------------------------
    I=17    Drive=R:
    --------------------------------------------------------------------------------
    I=18    Drive=S:
    --------------------------------------------------------------------------------
    I=19    Drive=T:
    DiskSign                       : T:
    DiskType                       : Remote
    VolumeLabel                    :
    --------------------------------------------------------------------------------
    I=20    Drive=U:
    DiskSign                       : U:
    DiskType                       : Remote
    VolumeLabel                    :
    --------------------------------------------------------------------------------
    I=21    Drive=V:
    --------------------------------------------------------------------------------
    I=22    Drive=W:
    --------------------------------------------------------------------------------
    I=23    Drive=X:
    --------------------------------------------------------------------------------
    I=24    Drive=Y:
    --------------------------------------------------------------------------------
    I=25    Drive=Z:
    DiskSign                       : Z:
    DiskType                       : Remote
    VolumeLabel                    :
    --------------------------------------------------------------------------------
    
    Unexpected Memory Leak
    An unexpected memory leak has occurred. The unexpected small block leaks are:
    
    61 - 68 bytes: UnicodeString x 1
    

  2. #2
    Ik heb even wat simpelere code gemaakt (zie onderaan) gewoon om te laten zien dat de fout vrij "simpel" is.
    Daar zie je dat het niets met de aanroep van WNetGetConnection te maken heeft.
    Je probleem ligt in het gebruik van string binnen een record.
    Op die manier wordt die string een 'unmaged' type en die zul je dus zelf handmatig vrij moeten geven.

    Overigens heb je 2 strings in je record want TDiskSign is ook een string.

    Ik kreeg overigens een foutmelding op de regel {$R *.res} omdat er geen resources zijn (verwijder die regel dus).

    Tevens kreeg ik een foutmelding op de WNetGetConnection() regels voor een invalid type cast.
    Ik begrijp niet waarom jij die niet kreeg.

    Als je de aanroep van GetDiskInfo gewoon even zo maakt dan koppel je die log van TDiskSign.
    function GetDiskInfo (aDiskSign : string) : TDiskInfo;

    Van je record maak je dan de string gewoon shortstrings (die hoeven niet gemanaged te zijn).
    Delphi Code:
    1. TDiskInfo                 = record
    2.     DiskSign                : shortstring;
    3.     DiskType                : TDiskType;
    4.     VolumeLabel             : shortstring;
    5.     ImageIndex              : integer;
    6.   end;

    Daarna zou het moeten werken.


    Dit is dus alleen code om het probleem te laten zien met een string binnen een record, dat die dus niet meer gemanaged wordt.
    Delphi Code:
    1. program TSTDiskInfoMemLeak;
    2.  
    3. {$APPTYPE CONSOLE}
    4.  
    5. uses
    6.   System.SysUtils,
    7.   WinAPI.Windows,
    8.   Winapi.ShellAPI;
    9.  
    10. type
    11.   TDiskInfo                 = record
    12.     DiskSign                : String; // <-- PROBLEEM
    13.     VolumeLabel             : string; // <-- PROBLEEM
    14.     ImageIndex              : integer;
    15.   end;
    16.  
    17. function GetDiskInfo (aDiskSign : String) : TDiskInfo;
    18. begin
    19.   Result.DiskSign       := aDiskSign;
    20.   Result.VolumeLabel    := '';
    21.   Result.ImageIndex     := -1;
    22. end;
    23.  
    24. var
    25.   lDiskInfo : TDiskInfo;
    26.   I : byte;
    27.   Drive: String;
    28. begin
    29.   ReportMemoryleaksOnShutdown := true;
    30.  
    31.   try
    32.     for I := 0 to 25 do
    33.       begin
    34.         FillChar(lDiskInfo, SizeOf(lDiskInfo), #0);
    35.         Drive := Char(I + Ord('A'))+':';
    36.         lDiskInfo := GetDiskInfo (Drive);
    37.       end;
    38.  
    39.   except
    40.     on E: Exception do
    41.       Writeln(E.ClassName, ': ', E.Message);
    42.   end;
    43.  
    44. end.

  3. #3
    PS. Je mag natuurlijk ook zelf die string weer vrijgeven na de print opdracht (binnen de loop).

    Delphi Code:
    1. SetLength(Result.VolumeLabel,0);

    Dat zal ook wel werken

  4. #4
    Win32.Trojan.Heur.Herby
    Join Date
    Dec 2003
    Location
    Nuenen of all places
    Posts
    289
    Quote Originally Posted by rvk View Post
    Ik heb even wat simpelere code gemaakt (zie onderaan) gewoon om te laten zien dat de fout vrij "simpel" is.
    Daar zie je dat het niets met de aanroep van WNetGetConnection te maken heeft.
    Je probleem ligt in het gebruik van string binnen een record.
    Op die manier wordt die string een 'unmaged' type en die zul je dus zelf handmatig vrij moeten geven.
    Toch snap ik het niet helemaal, ik verwachte eigenlijk dat "datgene" wat in het record komt te staan als result los zou staan van wat ik er in stop.
    Zodra de functie is afgerond gaat de rest van de code verder met een "gevuld" record.

    Quote Originally Posted by rvk View Post
    Overigens heb je 2 strings in je record want TDiskSign is ook een string.
    Ja dat klopt, maar de bedoeling was/is een string van 2 zodat C: wordt ingegeven en niet C:\blah

    Quote Originally Posted by rvk View Post
    Ik kreeg overigens een foutmelding op de regel {$R *.res} omdat er geen resources zijn (verwijder die regel dus).
    Dat is raar want dat is het default gedrag bij het maken van een console applicatie
    Code:
    program Project1;
    
    {$APPTYPE CONSOLE}
    
    {$R *.res}
    
    uses
      System.SysUtils;
    
    begin
      try
        { TODO -oUser -cConsole Main : Insert code here }
      except
        on E: Exception do
          Writeln(E.ClassName, ': ', E.Message);
      end;
    end.
    Quote Originally Posted by rvk View Post
    Tevens kreeg ik een foutmelding op de WNetGetConnection() regels voor een invalid type cast.
    Ik begrijp niet waarom jij die niet kreeg.
    Gebruik jij een oudere Delphi versie?
    Want bij mij complieert het zonder meldingen.

    Name:  2023-01-22 12_54_01-Window.png
Views: 153
Size:  3.8 KB

    Quote Originally Posted by rvk View Post
    Als je de aanroep van GetDiskInfo gewoon even zo maakt dan koppel je die log van TDiskSign.
    function GetDiskInfo (aDiskSign : string) : TDiskInfo;

    Van je record maak je dan de string gewoon shortstrings (die hoeven niet gemanaged te zijn).
    Delphi Code:
    1. TDiskInfo                 = record
    2.     DiskSign                : shortstring;
    3.     DiskType                : TDiskType;
    4.     VolumeLabel             : shortstring;
    5.     ImageIndex              : integer;
    6.   end;

    Daarna zou het moeten werken.
    Jouw code geeft inderdaad geen memory leak, maar ik begrijp nog niet helemaal het hoe en waarom

    Gr
    Herby

  5. #5
    Win32.Trojan.Heur.Herby
    Join Date
    Dec 2003
    Location
    Nuenen of all places
    Posts
    289
    Quote Originally Posted by rvk View Post
    PS. Je mag natuurlijk ook zelf die string weer vrijgeven na de print opdracht (binnen de loop).

    Delphi Code:
    1. SetLength(Result.VolumeLabel,0);

    Dat zal ook wel werken
    ik wil dus een TDiskInfo terug hebben zonder dat ik me daarna hoef druk te maken over het opruimen van strings.
    ik zie wat je gedaan hebt, het land alleen niet bij me :-)


    Gr
    Herby

  6. #6
    Win32.Trojan.Heur.Herby
    Join Date
    Dec 2003
    Location
    Nuenen of all places
    Posts
    289
    Het werkt inderdaad zonder problemen nu, al begrijp ik nog niet het hoe en waarom.

    Moest nog 1 kleine aanpassingen maken om een typecasting probleempje weg te poetsen.
    Een andere aanpassing omdat pchar naar shortstring voor bras zorgde ipv de string die uit lBufVolumeLabel kwam.

    Toch bedankt voor je hulp, was al dagen aan het stoeien met dit en kwam er gewoon niet uit.

    Code:
    
    program TSTDiskInfoMemLeak;
    
    {$APPTYPE CONSOLE}
    
    {$R *.res}
    
    uses
      System.SysUtils,
      WinAPI.Windows,
      Winapi.ShellAPI;
    
    type
      TDiskSign                 = string[2];
      TDiskType                 = (dtUnknown, dtNotExists, dtRemovable, dtFixed, dtRemote, dtCDROM, dtRAMDisk, dtRemovableNotConnected);
    
      TDiskInfo                 = record
        DiskSign                : shortstring;
        DiskType                : TDiskType;
        VolumeLabel             : shortstring;
        ImageIndex              : integer;
      end;
    
    function DiskTypeToStr (aDiskType: TDiskType) : string;
    begin
      case aDiskType of
        dtUnknown               : result := 'Unknown';
        dtNotExists             : result := 'Does''t exists';
        dtRemovable             : result := 'Removable';
        dtFixed                 : result := 'Fixed';
        dtRemote                : result := 'Remote';
        dtCDROM                 : result := 'CDrom';
        dtRAMDisk               : result := 'RAMdisk';
        dtRemovableNotConnected : result := 'Removable disconnected';
      end;
    end;
    
    function GetDiskInfo (aDiskSign : String) : TDiskInfo;
    var
      lpnLength             : Cardinal;
      lError                : DWORD;
      lBufVolumeLabel       : PChar;
    begin
      Result.DiskSign       := ShortString(aDiskSign);                                                                      // TDiskInfo.Sign = Driveletter STRING[2]
      Result.DiskType       := dtUnknown;                                                                                   // Init
      Result.VolumeLabel    := '';                                                  					// Init
      Result.ImageIndex     := -1;                                                  					// Init
    
    
      case GetDriveType(PChar(IncludeTrailingPathDelimiter(aDiskSign))) of               					// Check if drive removable, fixed, CD-ROM, RAM disk, or network drive.
        DRIVE_UNKNOWN       : Result.DiskType := dtUnknown;                        						// The drive type cannot be determined
        DRIVE_NO_ROOT_DIR   : Result.DiskType := dtNotExists;                      						// The root path is invalid. For example, no volume is mounted at the path.
        DRIVE_REMOVABLE     : Result.DiskType := dtRemovable;                      						// The disk can be removed from the drive.
        DRIVE_FIXED         : Result.DiskType := dtFixed;                          						// The disk cannot be removed from the drive
        DRIVE_REMOTE        : Result.DiskType := dtRemote;                         						// The drive is a remote (network) drive
        DRIVE_CDROM         : Result.DiskType := dtCDROM;                          						// The drive is a CD-ROM drive
        DRIVE_RAMDISK       : Result.DiskType := dtRAMDisk;                        						// The drive is a RAM disk
      end;
    
      if Result.DiskType = dtNotExists then                                                                                 // if NotExists then start checking for Disconnected drive
        begin
          lpnLength         := 0;                                                                                           // Init
    
          lError            := WNetGetConnection(PChar(aDiskSign), nil, lpnLength);              				// Get Size for lBufVolumeLabel in lpnLength
    
          if lError = ERROR_MORE_DATA then                                                                                  // size received in lpnLength
            begin
              lBufVolumeLabel := AllocMem(lpnLength);                                           				// Alloc memory for VolumeLabel buffer
              try
                lError := WNetGetConnection(PChar(aDiskSign), lBufVolumeLabel, lpnLength);       				// Get network name
                if lError = ERROR_CONNECTION_UNAVAIL then                                                                   // It exists but is unavailable
                  begin
                    Result.VolumeLabel := StrPas(lBufVolumeLabel);                                                          // Return volume label
                    Result.DiskType := dtRemovableNotConnected;                                                             // Return DiskType
                    Result.ImageIndex := SIID_DRIVENETDISABLED;                                                             // Set imageindex to disconnected icon
                  end
                else
                  Result.DiskType := dtNotExists;                                                                           // otherwise reurn dtNotExists
              finally
                FreeMem(lBufVolumeLabel, lpnLength);                                                                        // Free Memory
              end;
            end;
        end;
    end;
    
    
    var
      lDiskInfo : TDiskInfo;
      I : byte;
    begin
      ReportMemoryleaksOnShutdown := true;
    
    
      try
        for I := 0 to 25 do                                                                                                 // Loop through all possible drives
    //  I := 12;                                                                                                            // or use one
          begin
            FillChar(lDiskInfo, SizeOf(lDiskInfo), #0);                                                                     // Clear the DiskInfo record
            lDiskInfo := GetDiskInfo (Char(I + Ord('A'))+':');                                                              // Driveletter
    
            WriteLn (format('I=%d    Drive=%s',[I,lDiskInfo.DiskSign] ));
            if lDiskInfo.DiskType <> dtNotExists then
              begin
                WriteLn(format('%-30s : %s',['DiskSign'     ,lDiskInfo.DiskSign]));
                WriteLn(format('%-30s : %s',['DiskType'     ,DiskTypeToStr(lDiskInfo.DiskType)]));
                WriteLn(format('%-30s : %s',['VolumeLabel'  ,lDiskInfo.VolumeLabel]));
                //WriteLn(format('%-30s : %d',['ImageIndex'   ,lDiskInfo.ImageIndex]));
                WriteLn('--------------------------------------------------------------------------------');
              end
            else
              WriteLn('--------------------------------------------------------------------------------');
          end;
    
    
    
      except
        on E: Exception do
          Writeln(E.ClassName, ': ', E.Message);
      end;
    
      readln;
    end.
    
    

  7. #7
    Quote Originally Posted by Herby View Post
    Het werkt inderdaad zonder problemen nu, al begrijp ik nog niet het hoe en waarom.
    Een string is een pointer naar array of char (een memory reeks).
    String = ^array of char;

    Wanneer die string aangemaakt wordt dan zal een compiler automatisch geheugen reserveren en de pointer aan die variabele toekennen.
    Wanneer de string variabele niet meer gebruikt wordt dan zal de compiler automatisch een freemem doen voor de gereserveerde geheugen.
    String is een managed type.

    Allemaal niet zo spannend.
    MAAR...
    Wanneer een string in een record zit, dan wordt die string dus wel aangemaakt (memory gereserveerd en pointer in de string variabele)
    maar omdat de compiler daarna niet weet dat die string verborgen zit in een record, kan hij die ook niet meer vrijgeven.
    De string binnen het record wordt dus niet vrijgegeven en blijft in het memory hangen (vandaar je memory leak).

    Een shortstring is geen pointer maar eigenlijk gewoon een vaste array.
    ShortString = array[0..255] of char;

    Omdat hier geen pointers in het spel zijn en de array of char direct in het record staat, wordt deze ook netjes met het record zelf opgeruimd.

    Dus... een string binnen een record is meestal geen goed idee als je die niet zelf opruimt.

    Let overigens op dat jouw code een probleem krijgt wanneer een Volumelabel langer dan 255 karakters is.
    (Aangezien dat in Windows maar maximaal 32 karakters kan zijn zal dat probleem zich nooit voordoen, maar als je bv met files werkt zou dat wel kunnen)

  8. #8
    Win32.Trojan.Heur.Herby
    Join Date
    Dec 2003
    Location
    Nuenen of all places
    Posts
    289
    Hoi Rik,

    Bedankt voor je antwoord, dat maakt het geheel een stuk duidelijker.
    Wat wel vreemd is, is dat ik met records icm strings nog nooit eerder een probleem zoals dit heb gezien, misschien gewoon geluk gehad.

  9. #9
    Quote Originally Posted by Herby View Post
    Wat wel vreemd is, is dat ik met records icm strings nog nooit eerder een probleem zoals dit heb gezien, misschien gewoon geluk gehad.
    Had je daar ook dit staan?
    ReportMemoryleaksOnShutdown := true;

    Zonder dit krijg je geen melding. En aangezien het record, en dus ook de string reservering, elke keer opnieuw gebruikt wordt in de loop, heb je hooguit een leak van 1 string. Daar merkt je programma, zonder melding, niet zoveel van, want het OS geeft toch het hele geheugen vrij na beëindiging van je programma.

  10. #10
    Win32.Trojan.Heur.Herby
    Join Date
    Dec 2003
    Location
    Nuenen of all places
    Posts
    289
    Ja dat dat doe ik eigenlijk altijd om zeker van te zijn dat ik niet ergens iets vergeten ben

  11. #11
    Een Record is normaal net zo managed als String, maar in dit geval is het niet Delphi, maar jijzelf die voor de allocatie van het geheugen zorgt (met allocmem), en daardoor valt dit record buiten de boot.
    Overigens is een String een Delphi-eigen type, en doorgaans niet zo geschikt voor Windows API calls. String in Delphi is namelijk iets meer dan alleen een array. Hij heeft ook een lengte-indicator en een reference count.
    1+1=b

  12. #12
    Win32.Trojan.Heur.Herby
    Join Date
    Dec 2003
    Location
    Nuenen of all places
    Posts
    289
    Ik snap dat ik met AllocMem zelf het geheugen beheer, maar naam mijn weten ruimde ik ook netjes alles op.

    Code:
              lBufVolumeLabel := AllocMem(lpnLength);                                           				// Alloc memory for VolumeLabel buffer
              try
              .......
              finally
                FreeMem(lBufVolumeLabel, lpnLength);                                                                        // Free Memory
              end;
    Ik ben dan ook maar een hobby programmeur en mis op sommige punten blijkbaar nog de juiste kennis.
    Moet zeggen dat ik al wel wat boeken en een hoop arikelen over Delphi heb gelezen, maar het verhaal van Rik was dan ook volledig nieuw voor me.

    Wellicht eens wat nieuwe studie materiaal zoeken (hint?)

    Gr
    Herby

  13. #13
    Quote Originally Posted by GolezTrol View Post
    Een Record is normaal net zo managed als String, maar in dit geval is het niet Delphi, maar jijzelf die voor de allocatie van het geheugen zorgt (met allocmem), en daardoor valt dit record buiten de boot.
    Overigens is een String een Delphi-eigen type, en doorgaans niet zo geschikt voor Windows API calls. String in Delphi is namelijk iets meer dan alleen een array. Hij heeft ook een lengte-indicator en een reference count.
    Waarom geeft mijn testcode uit post #2 dan ook een memory leak.
    Daar heb ik de AllocMem en Windows calls er helemaal uit gesloopt en alleen met een string gewerkt.
    Het probleem is volgens mij toch echt een string binnen een record.

    Quote Originally Posted by Herby View Post
    Ja dat dat doe ik eigenlijk altijd om zeker van te zijn dat ik niet ergens iets vergeten ben
    Ik ook maar ik gebruik het dan wel in combinatie met DebugHook zodat dit niet in productie-code aan staat (maar alleen als ik in de IDE aan het debuggen ben)

    Delphi Code:
    1. {$WARN SYMBOL_PLATFORM OFF}
    2.   ReportMemoryLeaksOnShutdown := DebugHook <> 0;
    3. {$WARN SYMBOL_PLATFORM ON}

  14. #14
    Win32.Trojan.Heur.Herby
    Join Date
    Dec 2003
    Location
    Nuenen of all places
    Posts
    289
    Als ik dezelfde functionaliteit in een VCL app toe pas krijg ik een access denied.
    Dit gebeurd in de rode regel, vreemd dat dit in een console app wel goed gaat.


    Code:
    
    unit DriveUtils;
    
    interface
    
    uses
      System.SysUtils,
      WinAPI.Windows,
      Winapi.ShellAPI;
    
    type
      TDiskSign                 = string[2];
      TDiskType                 = (dtUnknown, dtNotExists, dtRemovable, dtFixed, dtRemote, dtCDROM, dtRAMDisk, dtRemovableNotConnected);
    
      TDiskInfo                 = record
        DiskSign                : shortstring;
        DiskType                : TDiskType;
        VolumeLabel             : shortstring;
        ImageIndex              : integer;
      end;
    
    function DiskTypeToStr (aDiskType: TDiskType) : string;
    function GetDiskInfo (aDiskSign : String) : TDiskInfo;
    
    
    implementation
    
    
    function DiskTypeToStr (aDiskType: TDiskType) : string;
    begin
      case aDiskType of
        dtUnknown               : result := 'Unknown';
        dtNotExists             : result := 'Does''t exists';
        dtRemovable             : result := 'Removable';
        dtFixed                 : result := 'Fixed';
        dtRemote                : result := 'Remote';
        dtCDROM                 : result := 'CDrom';
        dtRAMDisk               : result := 'RAMdisk';
        dtRemovableNotConnected : result := 'Removable disconnected';
      end;
    end;
    
    function GetDiskInfo (aDiskSign : String) : TDiskInfo;
    var
      lpnLength             : Cardinal;
      lError                : DWORD;
      lBufVolumeLabel       : PChar;
    begin
      Result.DiskSign       := ShortString(aDiskSign);                                                                      // TDiskInfo.Sign = Driveletter STRING[2]
      Result.DiskType       := dtUnknown;                                                                                   // Init
      Result.VolumeLabel    := '';                                                  					// Init
      Result.ImageIndex     := -1;                                                  					// Init
    
    
      case GetDriveType(PChar(IncludeTrailingPathDelimiter(aDiskSign))) of               					// Check if drive removable, fixed, CD-ROM, RAM disk, or network drive.
        DRIVE_UNKNOWN       : Result.DiskType := dtUnknown;                        						// The drive type cannot be determined
        DRIVE_NO_ROOT_DIR   : Result.DiskType := dtNotExists;                      						// The root path is invalid. For example, no volume is mounted at the path.
        DRIVE_REMOVABLE     : Result.DiskType := dtRemovable;                      						// The disk can be removed from the drive.
        DRIVE_FIXED         : Result.DiskType := dtFixed;                          						// The disk cannot be removed from the drive
        DRIVE_REMOTE        : Result.DiskType := dtRemote;                         						// The drive is a remote (network) drive
        DRIVE_CDROM         : Result.DiskType := dtCDROM;                          						// The drive is a CD-ROM drive
        DRIVE_RAMDISK       : Result.DiskType := dtRAMDisk;                        						// The drive is a RAM disk
      end;
    
      if Result.DiskType = dtNotExists then                                                                                 // if NotExists then start checking for Disconnected drive
        begin
          lpnLength         := 0;                                                                                           // Init
    
          lError            := WNetGetConnection(PChar(aDiskSign), nil, lpnLength);              				// Get Size for lBufVolumeLabel in lpnLength
    
          if lError = ERROR_MORE_DATA then                                                                                  // size received in lpnLength
            begin
              lBufVolumeLabel := AllocMem(lpnLength);                                           				// Alloc memory for VolumeLabel buffer
              try
                lError := WNetGetConnection(PChar(aDiskSign), lBufVolumeLabel, lpnLength);       				// Get network name
                if lError = ERROR_CONNECTION_UNAVAIL then                                                                   // It exists but is unavailable
                  begin
                    Result.VolumeLabel := ShortString(StrPas(lBufVolumeLabel));                                             // Return volume label
                    Result.DiskType := dtRemovableNotConnected;                                                             // Return DiskType
                    Result.ImageIndex := SIID_DRIVENETDISABLED;                                                             // Set imageindex to disconnected icon
                  end
                else
                  Result.DiskType := dtNotExists;                                                                           // otherwise reurn dtNotExists
              finally
                FreeMem(lBufVolumeLabel, lpnLength);                                                                        // Free Memory
              end;
            end;
        end;
    end;
    
    
    end.
    
    Code:
    
    unit DiskInfoVCLu1;
    
    interface
    
    uses
      Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
      Vcl.Controls, Vcl.Forms, Vcl.Dialogs;
    
    type
      TForm2 = class(TForm)
        procedure FormCreate(Sender: TObject);
      private
        { Private declarations }
      public
        { Public declarations }
      end;
    
    var
      Form2: TForm2;
    
    implementation
    
    {$R *.dfm}
    
    uses
      DriveUtils;
    
    procedure TForm2.FormCreate(Sender: TObject);
    var
      i         : byte;
      lDiskInfo : TDiskInfo;
    begin
        for I := 0 to 25 do                                                                                                 // Loop through all possible drives
          begin
            FillChar(lDiskInfo, SizeOf(lDiskInfo), #0);                                                                     // Clear the DiskInfo record
            lDiskInfo := GetDiskInfo (Char(I + Ord('A'))+':');                                                              // Driveletter
          end;
    end;
    
    end.
    
    Click image for larger version. 

Name:	2023-01-23 10_04_28-Window.png 
Views:	30 
Size:	3.9 KB 
ID:	8298

  15. #15
    Quote Originally Posted by Herby View Post
    Als ik dezelfde functionaliteit in een VCL app toe pas krijg ik een access denied.
    Dit gebeurd in de rode regel, vreemd dat dit in een console app wel goed gaat.
    Gaat bij mij goed (en ik heb wel gecontroleerd of de code daar kwam). Win32 en Win64.

Page 1 of 3 1 2 3 LastLast

Thread Information

Users Browsing this Thread

There are currently 1 users browsing this thread. (0 members and 1 guests)

Bookmarks

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •