Help to modify a program.

Forget it. I think I have solved this my self. But my solution seems to be realy slow. (probably due to some type castings. I will post my code when I get back home and hope that you can help me speed it up a bit instead.

Ok here is what I have:

It is slow as hell.. can someone help me to speed this up

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, DB, ADODB, ComCtrls;

type
  TForm1 = class(TForm)
    OpenDialog1: TOpenDialog;
    Button1: TButton;
    Edit1: TEdit;
    Qry: TADOQuery;
    ProgressBar1: TProgressBar;
    ADOConnection1: TADOConnection;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    hFile, hMap : THandle;
    ptrFileBase : Pointer;
    FileSize : Integer;
    procedure OpenFile;
    procedure CloseFile;

    procedure ScanUid;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

 uses FileCtrl;

const
  SELDIRHELP = 1000;

const
  MAX_FIELDS = 5;
  MAXCONTACTS = 1024;
  DATE_UNIX2DELPHI = 25570;
  SEC_PER_DAY = 86400;

type
  TContacts = record
    uin: LongWord;
    fields: array[0..MAX_FIELDS-1] of PChar;
  end;

  PArrayOfBytes = ^TArrayOfBytes;
  TArrayOfBytes = array of Byte;

  PArrayOfChar = ^TArrayOfChar;
  TArrayOfChar = array of Char;

var
  fieldNames: array[0..4] of string = ('MyDefinedHandle','NickName','FirstName','LastName','PrimaryEmail');
  fields: array[0..MAX_FIELDS-1] of PChar;
  cnt: integer = 0;
  contacts: array[0..MAXCONTACTS] of TContacts;

function btol(p: Pointer): LongWord;
begin
  Result:= LongWord(p^);
end;

function btos(p: Pointer): Word;
begin
  Result:= Word(p^);
end;

function getdate(p: Pointer): TDateTime;
var
  i: LongWord;
begin
  i := btol(p);
  if ( i<$80000000 ) then
    Result := Trunc(i/SEC_PER_DAY)+DATE_UNIX2DELPHI
 else
   Result := -1;
end;

function gettime(p: Pointer): TDateTime;
var
  i: LongWord;
begin
  i := btol(p);
  if ( i<$80000000 ) then
    Result := (i mod SEC_PER_DAY)/SEC_PER_DAY
  else
    Result := -1;
end;

function check_str(buf: Pointer; s,l,sz: integer): boolean;
var
  i: integer;
  e: integer;
  aoc : PArrayOfChar;
begin
  Result:= False;
  e := s+l-1;
  if e >= sz then exit;
  aoc:= @Buf;
  for i:=s to e-1 do
  begin
    if aoc^[i] = #0 then exit;
  end;
  result := aoc^[e] = #0;
end;

function lookup_field(key: PChar): integer;
var
  i: integer;
begin
  for i:=0 to MAX_FIELDS-1 do
    if key = fieldNames[i] then
    begin
      Result := i;
      exit;
    end;
  Result := -1;
end;

procedure contacts_put(uin: LongWord);
var
  n,i: integer;
begin
  n := 0;
  while ( n<cnt ) do
  begin
    if ( uin=contacts[n].uin ) then
      break;
    Inc(n);
  end;
  contacts[n].uin := uin;
  for i:=0 to MAX_FIELDS-1 do
  begin
    contacts[n].fields[i] := fields[i];
  end;
  if( n=cnt ) then
    Inc(cnt);
end;


procedure TForm1.FormCreate(Sender: TObject);
begin
 Edit1.Text:= '';
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
//
end;

procedure TForm1.Button1Click(Sender: TObject);
  var sr : TSearchRec;
      path : String;
      Dir: string;
begin
  Dir := 'C:\backup';
  Edit1.Text:= Dir;
  if SelectDirectory(Dir, [sdAllowCreate, sdPerformCreate, sdPrompt],SELDIRHELP) then
  Edit1.Text:= Dir;


  Path:= Edit1.Text;
  if FindFirst(Path+'\*.dat',faArchive,sr)=0 then begin
    repeat    {Search for files}

      Edit1.Text:= Path + '\' + sr.name;
      OpenFile;
      if ptrFileBase <> NIL then ScanUid;

    until (FindNext(sr)<>0);
    FindClose(sr);
  end;

  {
  if OpenDialog1.Execute then
  begin
    Edit1.Text:= OpenDialog1.FileName;
  end; }
end;

procedure TForm1.CloseFile;
begin
  if ptrFileBase <> NIL then UnmapViewOfFile(ptrFileBase);
  if hMap <> 0 then CloseHandle(hMap);
  if hFile <> 0 then CloseHandle(hFile);
  ptrFileBase:= NIL;
  hMap:= 0;
  hFile:= 0;
end;

procedure TForm1.OpenFile;
begin
  hFile:= CreateFile(PChar(Edit1.Text),GENERIC_READ,FILE_SHARE_READ or FILE_SHARE_WRITE,NIL,OPEN_EXISTING,FILE_ATTRIBUTE_NORMAL,0);
  if hFile <> 0 then begin
    FileSize:=GetFileSize(hFile,nil);
    hMap:=CreateFileMapping(hFile,nil,PAGE_READONLY,0,0,nil);
    if hMap <> 0 then begin
      ptrFileBase:=MapViewOfFile(hMap,FILE_MAP_READ,0,0,0);
      if ptrFileBase = nil then
        CloseFile;
    end else
      CloseFile;
  end else
    CloseFile;
end;

procedure TForm1.ScanUid;
var
  i,f : Integer;

  aob: PArrayOfBytes;
  aoc: PArrayOfChar;
  l: integer;
  invalid: boolean;
  dir: string;
  key: PChar;
  vlen: integer;
  uin: LongWord;
  qry1 : TadoQuery;
begin
  //Qry.SQL.Text:='truncate table contacts';
  //Qry.ExecSQL;

  //Qry.SQL.Text:='truncate table messages';
  //Qry.ExecSQL;

  for i:=0 to MAX_FIELDS-1 do
    fields[i]:= nil;

  ProgressBar1.Max:= FileSize;
  ProgressBar1.Position:=0;
  aob:= @ptrFileBase;
  aoc:= @ptrFileBase;
  i := 0;
  invalid:= True;
  while i<FileSize do
  begin
    ProgressBar1.Position:=i;
    l := btos(@aob^[i]);

    if ( (i>=9) and (l>1) and ((aob^[i-9] or aob^[i-8] or aob^[i-7] or aob^[i-5])=0) and (aob^[i-6]=1)
          ) and
          check_str(ptrFileBase,i+2,l,FileSize) and (aob^[i+l+15]>$32)
         then
      begin
        if aob^[i+l+6]=0 then
          dir := 'incomming'
        else
          dir := 'outgoing';

        //Qry.Parameters.ParamByName('date').Value:= getdate(@aob^[i+l+12]) + gettime(@aob^[i+l+12]);
        qry1:= TAdoQuery.Create(nil);
        Qry1.Connection:= ADOConnection1;
        qry1.SQL.Text:= 'select * from messages where uid=';
        qry1.SQL.Text:= Qry1.SQL.Text + '''' + FloatToStr(btol(@aob^[i-4])) + '''';
        qry1.SQL.Text:= Qry1.SQL.Text + 'and time=' + '''' +  DateTimeToStr(getdate(@aob^[i+l+12]) + gettime(@aob^[i+l+12])) + '''';
        qry1.Open;
        if Qry1.Eof then
        begin
          Qry.SQL.Text:='insert into messages values(:uid,:date,:dir,:msg)';
          Qry.Parameters.ParamByName('uid').Value:= btol(@aob^[i-4]);
          Qry.Parameters.ParamByName('date').Value:= getdate(@aob^[i+l+12]) + gettime(@aob^[i+l+12]);
          Qry.Parameters.ParamByName('dir').Value:= (aob^[i+l+6]<>0);
          Qry.Parameters.ParamByName('msg').DataType:= ftString;
          Qry.Parameters.ParamByName('msg').Value:= Copy(PChar(@aoc^[i+2]),1,l-1);
          Qry.ExecSQL;

        end;
        Qry1.Free;
//        Memo1.Lines.Add(Format('<entry uin="%d" secs="%d" date="%s" time="%s" dir="%s">',
//                          [btol(@aob^[i-4]),btol(@aob^[i+l+12]),DateToStr(getdate(@aob^[i+l+12])),TimeToStr(gettime(@aob^[i+l+12])),dir]));
{
        print_xml(fd,@buf[i+2],l-1);
        Bwriteln(fd,'</entry>');
}
        invalid := true;
      end
    else if ( (l>1) and check_str(ptrFileBase,i+2,l,FileSize) ) then
    begin
      if invalid then
      begin
        for f:=0 to MAX_FIELDS-1 do fields[f] := nil;
        invalid := false;
      end;
      key := @aoc^[i+2];
      if ( aoc^[i+l+2]='k' ) then
      begin
        vlen := btos(@aob^[i+l+3]);
        if ( check_str(ptrFileBase,i+l+5,vlen,FileSize) ) then
        begin
          if ( vlen>1 ) then
          begin
            f := lookup_field(key);
            if ( f>=0 ) then
              fields[f] := @aoc^[i+l+5];
          end;
          Inc(i,2+l+1+2+vlen-1);
        end;
      end
      else if aoc^[i+l+2]='i' then
      begin
        if ( key='UIN' ) then
        begin
          uin := btol(@aob^[i+l+3]);
          if ( (fields[1]<>nil) or (fields[2]<>nil) ) then
            contacts_put(uin);
        end;
        Inc(i,2+l+1+4-1);
      end
      else if (aoc^[i+l+2]='d') or (aoc^[i+l+2]='e') then
      begin
        Inc(i,2+l+1);
      end
      else if (aoc^[i+l+2]='f') or (aoc^[i+l+2]='g') then
      begin
        Inc(i,2+l+1+1);
      end
      else
        invalid := true
    end
    else
      invalid := true;
    Inc(i);
  end;
  for i:=0 to cnt-1 do
   begin
     Qry.SQL.Text:='insert into contacts values(:uid,:MyDefinedHandle,:NickName,:FirstName,:LastName,:PrimaryEmail)';
     Qry.Parameters.ParamByName('uid').Value:= contacts[i].uin;
     for f:=0 to MAX_FIELDs-1 do
     begin
       if ( contacts[i].fields[f]<>nil ) then
         Qry.Parameters.ParamByName(fieldNames[f]).Value:= String(contacts[i].fields[f])
       else
         Qry.Parameters.ParamByName(fieldNames[f]).Value:= Null;
     end;
     Qry.ExecSQL;
   end;



  {
  for i:=0 to cnt-1 do
  begin
    Qry.SQL.Text:='insert into contacts values(:uid,:MyDefinedHandle:NickName,:FirstName,:LastName,:PrimaryEmail)';
    Qry.Parameters.ParamByName('uid').Value:= contacts[i].uin;
    for f:=0 to MAX_FIELDs-1 do
    begin
      if ( contacts[i].fields[f]<>nil ) then
        Qry.Parameters.ParamByName(fieldNames[f]).Value:= String(contacts[i].fields[f])
      else
        Qry.Parameters.ParamByName(fieldNames[f]).Value:= Null;
    end;
    Qry.ExecSQL;
  end;}
end;


end.

It seems like one thing that slove things up is the Progress bar. (but I still want to have it.. I have not been able to fix this)

Suggestions:
1. If you aren't using a stored procedure, parameterized query, or querydef object, then don't use parameters.  Just construct a regular INSERT SQL statement.

2. It appears as though you are appending rows from one table to another one-at-a-time.  If this is the case, use this version of the INSERT statement:
INSERT INTO tblname (col1, col2, ..., coln)
SELECT fcol1, expression, literal, ..., fcoln FROM anothertblname
WHERE SomeConditionIsTrue

3. Use transactions to reduce the number of commits being performed by the database engine.

Do you think you can give me some code example for my case.
(i'm not so good at sql)

I also think that it's not only the sql that slow everything down

wqclatre,

ADOConnection1.Execute
'insert into messages (UID, DATE, DIR, MSG) values (' + btol(@aob^[i-4]) + ' , ' + getdate(@aob^[i+l+12]) + gettime(@aob^[i+l+12])  + ' , ' + (aob^[i+l+6]<>0) + ' , ' + Copy(PChar(@aoc^[i+2]),1,l-1)  + ' )';

Note: (UID, DATE, DIR, MSG) should be the actual column names in the messages table.

Note: I recommend the same treatment of the contacts table insert (use dynamic SQL rather than create a temporary parameterized query).

===============================================
I recommend adding (creating) a unique index on the UID field and trapping the duplicate-value error rather than doing a search for any records with that key.

===============================================
Please explain what data you are using to help me understand your code.

What do you mean with what data i'm using? And with trapping the duplicate-value error ?

uid can not be a unique index.
What i try to do is to extract things from my icq dat file
(uin, time for the message, direction, and the message sent)

so I like to have more than one message for each person.

create the unique index on both the uid and time columns.

==========================================
You answered my "what data" question when you let me know that this is ICQ log data.  It might also help if you let us know what kind of database you are using.

You might want to look at the time it takes to parse the raw data versus the time it takes to insert the rows.

What do your ICQ records look like?

==========================================
I don't know how much text you are storing, but a non-memo field will be faster than a memo-sized field.

My icq records is taken from c:\program files\icq\2002\"my uin".dat
(where "my uin" is a number)

Btw If I use the uniq indexes.. how do I get rid of the exceptions.. ( i mean it will stop running on the first exception and dont insert next row... right?)

I guess I can put try exept around all Open and SqlExecute statements but will that be faster?

wqclatre,

Thank you for the points.  I'm curious as to what performance improvement(s) have you observed/measured?

When I make all as store-procedures I get a lot of better preformence.. Things that tooks about 3 minits gose in a few seconds now.