Intro Download and install Frequently Asked Questions Tips and tricks

Homepage







© J.C. Kessels 2009
MyDefrag Forum
October 31, 2014, 11:47:33 pm *
Welcome, Guest. Please login or register.

Login with username, password and session length
News:
 
   Home   Help Search Login Register  
Pages: 1 [2] 3 4
  Print  
Author Topic: Error Use Library In Delphi.  (Read 57806 times)
jeroen
Administrator
JkDefrag Hero
*****
Posts: 7233



View Profile WWW
« Reply #15 on: June 11, 2007, 08:02:58 am »

The SpaceHogs (and the Excludes) must be finished with a "nil" string as the last string. For example:
Code:

var
SpaceHogs : Array[0..2] of PWideChar = (
  'first hog',
  'second hog',
  nil
  );

p.s. Why are you trying to disable the default spacehogs?
Logged
sonykalkan
JkDefrag Senior
****
Posts: 21


View Profile
« Reply #16 on: June 11, 2007, 09:01:38 am »

Thank you for your quick helps. I have modified the code again according your feedbacks. But the same access violation occurs. I am sure there is something we miss but i cannot find it.
Below is the modified code:
Regards,

Code:
var
spacehogs:array[0..1] of pwidechar=(nil,nil);
Excludes:array [0..1] of pwidechar=(nil,nil);
DebugMessages:array of pwidechar;
running,redrawscreen:integer;



Code:
procedure TForm1.Button1Click(Sender: TObject);
var
vol : PwideChar;

begin

GetMem(vol,20 );
vol := 'd:\share';

DebugMessages:=nil;

RunJkDefrag(vol,0,0, 10,excludes,spacehogs,@running,@redrawscreen,nil,nil,nil,nil,nil,nil,     DebugMessages);

Freemem(vol);
end;
Logged
jeroen
Administrator
JkDefrag Hero
*****
Posts: 7233



View Profile WWW
« Reply #17 on: June 11, 2007, 09:18:55 am »

I'm sorry but I don't see any problems this time. But then again I never use Delphi. I can only suggest that you start with my exact example, make changes one by one and test every time, to narrow the problem down.
Logged
sonykalkan
JkDefrag Senior
****
Posts: 21


View Profile
« Reply #18 on: June 11, 2007, 11:52:46 am »

I did a little progress about the problem.
I have inserted messagebox routine in c++ dll code to see what happens.

First
*Data->RedrawScreen = NO;
gave the exception , i have changed the line and similar ones with
Data->RedrawScreen = NO;

When i rerun the delphi code, there was no exception there but, the following line gaves the exception.
I dont know which part of the callshowstatus code gave the exception, because i dont know how to debug a dll. but the following line gave it.

CallShowStatus(Data,7,-1);                     /* "Finished." */
Logged
jeroen
Administrator
JkDefrag Hero
*****
Posts: 7233



View Profile WWW
« Reply #19 on: June 11, 2007, 12:23:04 pm »

Quote from: "sonykalkan"
*Data->RedrawScreen = NO;
gave the exception , i have changed the line and similar ones with
Data->RedrawScreen = NO;

I'm sorry but that is totally wrong. It set's the value of the pointer to zero, not the value of the RedrawScreen variable. Perhaps it's a near/far pointer problem?

Quote from: "sonykalkan"
CallShowStatus(Data,7,-1);                     /* "Finished." */

All I can say is that it works perfectly when called from C. It must be something to do with the callback subroutines. Have you tried with setting them to "nil"?
Logged
sonykalkan
JkDefrag Senior
****
Posts: 21


View Profile
« Reply #20 on: June 11, 2007, 10:23:39 pm »

I think there is something wrong with calling conventions. All of the delphi ones are set to stdcall but no way.
Now, i gave up with using dll usage because the callbacks also give error when using executable file in delphi without debugging with ide itself.
th error is Microsoft Visual C++ Debug Library, Debug Error! Run time check failure #0- The value of ESP was not properly saved accross a function call....

Is there a chance that i can communicate command line debugger with delphi. i.e from the log file. (but i think the log file will be too big if the debug level is detailed).

Regards,
Logged
sonykalkan
JkDefrag Senior
****
Posts: 21


View Profile
« Reply #21 on: June 12, 2007, 08:56:17 am »

I have rechecked the codes and understand a little bit the problems caused.
* when i choose all callbacks nil, there is an exception after analysing is about to finish.
* TDefragShowAnalyzeCallback,TDefragDrawClusterCallback work very well, i can get the parameters and draw my own clusters.
* There is an error of calling convention of TDefragShowDebugCallback when running the software out of delphi ide. The error was Debug Error! Run time check failure #0

Regards,
Logged
jeroen
Administrator
JkDefrag Hero
*****
Posts: 7233



View Profile WWW
« Reply #22 on: June 12, 2007, 11:04:37 am »

Quote from: "sonykalkan"
* when i choose all callbacks nil, there is an exception after analysing is about to finish.

Very strange, I don't understand how that could be happening. I have tested the example code that I posted yesterday with Free Pascal in Delphi mode, and it works perfectly, no crash.

p.s. I know there is a free trial version of Delphi, but I have no intention whatsoever of buying it.
Logged
jeroen
Administrator
JkDefrag Hero
*****
Posts: 7233



View Profile WWW
« Reply #23 on: June 14, 2007, 02:58:24 am »

I have released v3.15 of JkDefrag with some changes that I hope will help Delphi programmers. All callbacks are now CDECL, and there is now an example Pascal program (very basic) that works for me on Free Pascal.
Logged
sonykalkan
JkDefrag Senior
****
Posts: 21


View Profile
« Reply #24 on: June 15, 2007, 12:29:56 pm »

First thank you for the new release special to delphi users.
I have downloaded Lazarus free pascal ide and tried the codes there.
With callbacks set to nil values, everything seems ok but i need visualation of defrag. So when the debug comes to

procedure TDefragShowDebugCallback(Level: Integer; Item: PItemStruct; Msg: PChar);  CDECL;

first call to this event seems ok, but in second arrival, the debugger shows the error:
execution paused.
procedure: treeprev

I think there is something to do with treeprev function in c++ dll code

Regards
Logged
jeroen
Administrator
JkDefrag Hero
*****
Posts: 7233



View Profile WWW
« Reply #25 on: June 15, 2007, 01:13:36 pm »

If I understand correctly then you are trying to call the DLL's treeprev() function from within your Pascal code? Can you show me your code? I'm not sure if I can help you with your Pascal code, but I'm willing to take a look. By the way, the "Item" parameter to the ShowDebug() callback does not always point to a valid item, it can sometimes be NULL (nil).
Logged
sonykalkan
JkDefrag Senior
****
Posts: 21


View Profile
« Reply #26 on: June 15, 2007, 01:53:25 pm »

I dont call treeprev() function
the main code is

Code:


unit Unit2;

{$mode objfpc}{$H+}

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls,DefragAPI,
  DataUnit,
  UInt64Lib, ExtCtrls,
  LResources, Buttons;




type

  { TForm1 }

  TForm1 = class(TForm)
    Button1: TButton;
    Image1: TImage;
    Label1: TLabel;
    Label2: TLabel;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  spacehogs:pwidechar=nil;
  Excludes:pwidechar=nil;
  DebugMessages:pwidechar=nil;
  running,redrawscreen:integer;
  count:integer=0;

implementation

{ TForm1 }
procedure TDefragShowStatusCallback(Data: PDefragDataStruct); CDECL;
begin
//form1.label1.caption:= inttostr(Data^.Speed);
end;
procedure TDefragShowMoveCallback(Item: PItemStruct; Clusters, FromLcn, ToLcn,FromVcn: ULONG64 ); CDECL;
var
  rect:TRect;
  newcolor:TColor;
  i,j:integer;
  totcluster:ulong64;
begin
form1.label1.caption:=inttostr(FromLcn)+':'+inttostr(ToLCn)+':'+inttostr(Clusters)+':'+inttostr(FromVCN);

  form1.Image1.Canvas.Pen.Color:=clgreen;
  form1.image1.Canvas.MoveTo(ToLcn mod 400,ToLcn div 400);
  for i:=ToLcn to ToLcn+clusters do
  begin
    form1.image1.Canvas.LineTo(i mod 400,i div 400);
  end;
  form1.image1.Canvas.MoveTo(FromLcn mod 400,FromLcn div 400);
  form1.Image1.Canvas.Pen.Color:=clBlack;
  for i:=FromLcn to FromLcn+clusters do
  begin
    form1.image1.Canvas.LineTo(i mod 400,i div 400);
  end;

end;

procedure TDefragShowAnalyzeCallback(Data: PDefragDataStruct; Item:PItemStruct); CDECL;
begin
  if(item<>nil) then
    form1.label1.caption:= item^.Path;

end;

procedure TDefragShowDebugCallback(Level: Integer; Item: PItemStruct; Msg: PChar); CDECL;
begin
form1.label1.caption:= inttostr(level)+msg;

end;

procedure TDefragDrawClusterCallback(Data: PDefragDataStruct; ClusterStart, ClusterEnd: ULONG64; Color: Integer); CDECL;
var
  rect:TRect;
  newcolor:TColor;
  i,j:integer;
  totcluster:integer;
begin

  totcluster:=data^.TotalClusters;
  if(color=0)then newcolor:=clGreen;
  if(color=1)then newcolor:=clNavy;
  if(color=2)then newcolor:=clRed;

  form1.Image1.Canvas.Pen.Color:=newcolor;
  form1.image1.Canvas.MoveTo(clusterstart mod 400,clusterstart div 400);
  for i:=clusterstart to ClusterEnd do
  begin
    form1.image1.Canvas.LineTo(i mod 400,i div 400);
  end;

  form1.label2.caption:=inttostr(clusterstart)+':'+inttostr(data^.TotalClusters);
 
  count:=count+1;
  if(count mod 1000 = 0) then
  Application.ProcessMessages;

end;

procedure TDefragClearScreenCallback(Msg: PChar); CDECL;
begin
//
end;

procedure TForm1.Button1Click(Sender: TObject);
begin



  running:=0;
  redrawscreen:=0;
  DebugMessages:=nil;
  Excludes:=nil;
  spacehogs:=nil;
  RunJkDefrag('c:\cache',2,0, 10,excludes,spacehogs,nil,nil,@TDefragShowStatusCallback,@TDefragShowMoveCallback,@TDefragShowAnalyzeCallback,@TDefragShowDebugCallback,@TDefragDrawClusterCallback,nil,     DebugMessages);

end;

initialization
  {$I unit2.lrs}

end.



Dataunit.pas is
Code:

unit DataUnit;

interface
uses Windows, Uint64Lib;

const
NO = 0;
YES = 1;

RUNNING = 0;
STOPPING = 1;
STOPPED = 2;


type
Pinteger = ^longint;
PPWChar= ^PWChar;
PPChar= ^PChar;
ULONG64= UINT64;

// List in memory of the fragments of a file. */
PFragmentListStruct=^TFragmentListStruct;
TFragmentListStruct=record
Lcn: ULONG64; //* Logical cluster number, location on disk. */
NextVcn: ULONG64; //* Virtual cluster number of next fragment. */
Next:PFragmentListStruct;
end;
FragmentListStruct=TFragmentListStruct;


//* List in memory of all the files on disk, sorted by LCN (Logical Cluster Number).
PItemStruct=^ TItemStruct;

TItemStruct= record
Parent: PItemStruct; //* Parent item. */
Smaller: PItemStruct; //* Next smaller item. */
Bigger: PItemStruct; //* Next bigger item. */
Path: PWChar; //* Full path on disk. */
Bytes: ULONG64; //* Total number of bytes. */
Clusters: ULONG64; //* Total number of clusters. */
CreationTime:ULONG64; //                        /* 1 second = 10000000 */
LastAccessTime:  ULONG64 ;
LastWriteTime:  ULONG64 ;
Fragments: PFragmentListStruct; //* List of fragments. */
Directory: Char; //* YES: it's a directory. */
Unmovable: Char; //* YES: file can't/couldn't be moved. */
Exclude: Char; //* YES: file is not to be defragged/optimized. */
SpaceHog:char ;
end;
ItemStruct= TItemStruct;


//* List of clusters used by the MFT. */
PExcludesStruct=^TExcludesStruct;
TExcludesStruct=record
Start: ULONG64;
iEnd: ULONG64;
end;
ExcludesStruct= TExcludesStruct;

PDefragDataStruct=^TDefragDataStruct;




TDefragShowStatusCallback=procedure(Data: PDefragDataStruct); CDECL;
TDefragShowMoveCallback = procedure(Item: PItemStruct; Clusters, FromLcn, ToLcn,FromVcn: ULONG64 ); CDECL;
TDefragShowAnalyzeCallback = procedure(Data: PDefragDataStruct; Item:PItemStruct); CDECL;
TDefragShowDebugCallback = procedure(Level: Integer; Item: PItemStruct; Msg: PChar); CDECL;
TDefragDrawClusterCallback= procedure(Data: PDefragDataStruct; ClusterStart, ClusterEnd: ULONG64; Color: Integer); CDECL;
TDefragClearScreenCallback= procedure(Format: PChar); CDECL;

TDefragDataStruct=record
  Phase:integer;                             {The current Phase (1...3). }
  Zone:integer;                    { The current Zone (0..2) for Phase 3. }
  Running:pinteger;                { If not RUNNING then stop defragging. }
  RedrawScreen:pinteger;            { If YES then redraw complete screen. }
  Path: PWChar;                     { Example: "c:\t1\" }
  MountPoint: PWChar;                { Example: "c:" }
  MountPointSlash:PWChar;
  VolumeName:array[0..50] of WChar;  { Example: "\\?\Volume 08439462-3004-11da-bbca-806d6172696f " }
  VolumeHandle: THandle;             { Handle to the volume. }
  IsNtfs: BOOL;                      { True if it's an NTFS volume. }
  FreeSpace: Double;          { Percentage of total disk size 0..100. }

ItemTree: PItemStruct;  { Tree in memory with information about all the files. }
BalanceCount: Integer;
Excludes: PPWChar;                        { Array with exclude masks. }
SpaceHogs: PPWChar;             { Array with SpaceHog masks. }
Zones: array[0..2] of ULONG64;     { Begin of Directory, Regular, and SpaceHog zones. }
MftExcludes: array[0..2] of ExcludesStruct;  { List of clusters reserved for the MFT. }
  { Counters filled before Phase 1. }
TotalClusters: ULONG64;{ Size of the volume, in clusters. }
BytesPerCluster: ULONG64; { Number of bytes per cluster. }
CountFreeClusters: ULONG64;
CountGaps: ULONG64;
BiggestGap: ULONG64;
CountGapsLess16: ULONG64;
CountClustersLess16: ULONG64;

CountDirectories: ULONG64;
CountAllFiles: ULONG64;
CountFragmentedItems: ULONG64;
CountAllBytes: ULONG64;
CountFragmentedBytes: ULONG64;
CountAllClusters: ULONG64;
CountFragmentedClusters: ULONG64;
PhaseToDo: ULONG64;
PhaseDone: ULONG64;

Speed: Integer;
StartTime: Int64;
RunningTime: Int64;
LastCheckpoint: Int64;
 Showstatprod:TDefragShowStatusCallback;
 ShowMoveProd:TDefragShowMoveCallback;
 ShowAnalyzeprod:TDefragShowAnalyzeCallback;
 ShowDebugProd:TDefragShowDebugCallback;
 DrawClusterProd:TDefragDrawClusterCallback;
 ClearScreenProd:TDefragClearScreenCallback;
 DebugMsg:PPChar ;



end;



DefragDataStruct=TDefragDataStruct;
var
MAXULONG64: UINT64 =0;
implementation

initialization
//MAXULONG64 := StrToUInt64('18446744073709551615');
end.



defragapi.pas is

Code:

unit DefragApi;

interface
uses Windows, DataUnit;




procedure RunJkDefrag(
  Path: PWideChar;
  Mode: Integer;
  Speed: Integer;
  FreeSpace: Double;
  Excludes: PWideChar;
  SpaceHogs: PWideChar;
  Running: PInteger;
  RedrawScreen: PInteger;
  ShowStatus, ShowMove, ShowAnalyze, ShowDebug, DrawCluster, ClearScreen: Pointer;
  DebugMsg: PWideChar);

  CDECL;external 'JkDefragdll' name 'RunJkDefrag';

procedure StopJkDefrag(Running: Pointer; TimeOut: Integer);

  CDECL;external 'JkDefragdll' name 'StopJkDefrag';




implementation

end.
                       
Logged
jeroen
Administrator
JkDefrag Hero
*****
Posts: 7233



View Profile WWW
« Reply #27 on: June 15, 2007, 07:30:40 pm »

I haven't checked all your code, because I immediately noticed that your definition of TDefragShowDebugCallback and (TDefragClearScreenCallback) lacks a parameter. I think your code was meant for an old version of jkDefrag.
Logged
sonykalkan
JkDefrag Senior
****
Posts: 21


View Profile
« Reply #28 on: June 16, 2007, 05:46:02 pm »

I have changed two procedures with the ones below, but the same error appears:

Execution paused
Procedure TreePrev
File:


The changed lines are:

procedure TDefragShowDebugCallback(Level: Integer; Item: PItemStruct; Msg: PChar; Args: Array of const); CDECL;


procedure TDefragClearScreenCallback(Msg: PChar; Args: Array of const); CDECL;
Logged
jeroen
Administrator
JkDefrag Hero
*****
Posts: 7233



View Profile WWW
« Reply #29 on: June 16, 2007, 06:54:37 pm »

I have tried compiling the source you posted before with Free Pascal but I get lot's of error messages. I guess your sources are not compatible with (the Delphi compatibility mode of) Free Pascal.

I did notice that in your "unit2.pas" source you call RunJkDefrag with a literal char string as the first parameter. It must be a pointer to a widechar string. Furthermore the definition of your RunJkDefrag is wrong, you have defined Excludes, SpaceHogs, and DebugMsg as "PWideChar", but all three must be "array of PWideChar".

I'm sorry, but I get the impression that you haven't even looked at the example Pascal program in the JkDefrag sources, there are so many important differences....
Logged
Pages: 1 [2] 3 4
  Print  
 
Jump to:  

Powered by MySQL Powered by PHP Powered by SMF 1.1.5 | SMF © 2006-2008, Simple Machines LLC Valid XHTML 1.0! Valid CSS!