Unnamed

Unit DUtils;

{DUTILS v1.1b Library for most used functions in Delphi
Automatic manipulation on text, dialogs, files and similiar windows function...}

INTERFACE

uses mysql, Windows, Dialogs, StrUtils, SysUtils, Classes, mmsystem, Variants;

//Constants declarations

//Types

// CLASS declarations

type TDatabase = class
protected
cur_dir:string;
DataBaseName:string;
private
MySQLLib:PMYSQL;
public
Fields: PMYSQL_FIELDS;
Row: PMYSQL_ROW;
Offset: MYSQL_ROW_OFFSET;
QResult: PMYSQL_RES;
FieldCount: longword;
RowCount: longword;
MySQLError:string;
//Mysql related
function MySqlGetQuery(ip:string;user:string;pass:string;db:string;query:string):boolean;
function MySqlQuery(query:string):boolean;
function MySqlSeekFirstRow:boolean;
function MySqlGetRow:boolean;
function MySqlClose:boolean;
end;

type TFiles = class
  function Read(Filename:string):string;
  procedure Save(Filename:string; Buffer: string);
  procedure Append(Filename:string; Buffer: string);
end;

type TDialogs = class
  function Save:string;
  function Open:string;
private
public
end;

type TStr = class
  function HextoBinFast(Value: String): String;
  function BinToHexFast(Value: String): String;
  function str2int(Number:string):integer;
  function GetFieldbyRandomText(SourceText:string;FieldName:string;FieldIndex:integer):string;
  function ReplaceText(SourceText:string; TextToFind:string; TextToReplace:string):string;
  function FastMidStr(SourceText:string; StringStart:integer; StringCount:integer):string;
  function TextBetween(SourceText:string; FirstSign:string; LastSign:string):string;
  function GetField(SourceText:string; Separator:char; Index:integer):string;   //Great for comma separated values and similiar
  function GetAndCutText(var SourceText:string; CutTo:string):string;
  function DestroyChars(SourceText:string; Char:char):string;
  function GetAndDeleteLine(var SourceText:string):string;
  function CutTextTo(SourceText:string; CutTo:string):string;
  function CutTextToFastChar(SourceText:string; CutTo:string):string;  
  function PosText(SourceText:string; SearchString:string):integer;   //This function reads string no matter what format is
  function CutIncludeTextTo(SourceText:string; CutTo:string):string;
  function NumberOfRepeats(SourceText:string; TextToSearch:string):integer;
  function HexToStr(Hex:string):string;
  function StrToHex(Str:string):string;
  function SmartPos(const substr : AnsiString; const s : AnsiString; StartPos : integer) : Integer;
private
public
end;

var Str:TStr;
    Dialogs:TDialogs;
    Files:TFiles;
    Buffer:PChar;
    BufferTemp:Pchar;

IMPLEMENTATION
{ TStr }

function TStr.BinToHexFast(Value: String): String;
var len,cntr: Integer;
begin
  Result:='';
  len:=length(value);
  for cntr:=1 to len do
  begin
  Result:=Result+inttohex(ord(Value[cntr]),2);
  end;

end;

function TStr.NumberOfRepeats(SourceText:string; TextToSearch:string):integer;
var i:integer;
begin
//repeats of text
Result:=0;
for i:=1 to length(SourceText) do
begin
if i>(length(SourceText)-Length(textToSearch)) then exit;
if copy(SourceText,i,length(TextToSearch))=TextToSearch then inc(Result);
end;
end;

function TStr.ReplaceText(SourceText:string; TextToFind:string; TextToReplace:string):string;
var i:integer;
//    s1,s2:string;
begin
Result:='';
for i:=1 to length(SourceText) do
begin
if copy(SourceText,i,length(TextToFind))=TextToFind then
begin
SourceText:=copy(Sourcetext,1,i-1)+TextToReplace+copy(Sourcetext,i+length(TextToFind),length(SourceText)-i+length(TextToFind));
end;
Result:=SourceText;
end;
end;

function SmartPosAsm(const substr : AnsiString; const s : AnsiString; StartPos : Cardinal) : Integer;
type
  StrRec = packed record
    allocSiz: Longint;
    refCnt: Longint;
    length: Longint;
  end;
const
  skew = sizeof(StrRec);
asm
{     ->EAX     Pointer to substr               }
{       EDX     Pointer to string               }
{     <-EAX     Position of substr in s or 0    }
        TEST    EAX,EAX
        JE      @@noWork

        TEST    EDX,EDX
        JE      @@stringEmpty

        PUSH    EBX
        PUSH    ESI
        PUSH    EDI

        MOV     ESI,EAX                         { Point ESI to substr           }
        MOV     EDI,EDX                         { Point EDI to s                }

        MOV     EAX,ECX
        MOV     ECX,[EDI-skew].StrRec.length    { ECX = Length(s)               }
        ADD     EDI,EAX
        SUB     ECX,EAX

        PUSH    EDI                             { remember s position to calculate index        }

        MOV     EDX,[ESI-skew].StrRec.length    { EDX = Length(substr)          }

        DEC     EDX                             { EDX = Length(substr) - 1              }
        JS      @@fail                          { < 0 ? return 0                        }
        MOV     AL,[ESI]                        { AL = first char of substr             }
        INC     ESI                             { Point ESI to 2'nd char of substr      }

        SUB     ECX,EDX                         { #positions in s to look at    }
                                                { = Length(s) - Length(substr) + 1      }
        JLE     @@fail
@@loop:
        REPNE   SCASB
        JNE     @@fail
        MOV     EBX,ECX                         { save outer loop counter               }
        PUSH    ESI                             { save outer loop substr pointer        }
        PUSH    EDI                             { save outer loop s pointer             }

        MOV     ECX,EDX
        REPE    CMPSB
        POP     EDI                             { restore outer loop s pointer  }
        POP     ESI                             { restore outer loop substr pointer     }
        JE      @@found
        MOV     ECX,EBX                         { restore outer loop counter    }
        JMP     @@loop

@@fail:
        POP     EDX                             { get rid of saved s pointer    }
        XOR     EAX,EAX
        JMP     @@exit

@@stringEmpty:
        XOR     EAX,EAX
        JMP     @@noWork

@@found:
        POP     EDX                             { restore pointer to first char of s    }
        MOV     EAX,EDI                         { EDI points of char after match        }
        SUB     EAX,EDX                         { the difference is the correct index   }
@@exit:
        POP     EDI
        POP     ESI
        POP     EBX
@@noWork:
end; //SmartPosAsm

function TStr.SmartPos(const substr : AnsiString; const s : AnsiString; StartPos : integer) : Integer;
begin
  dec(StartPos);
  Result := SmartPosAsm(SubStr,S,StartPos);
  if Result > 0 then Result := Result + StartPos;
end; //cnsSmartPos

function TStr.FastMidStr(SourceText:string; StringStart:integer; StringCount:integer):string;
begin
Result:=copy(SourceText,StringStart,StringCount);
end;

function TStr.TextBetween(SourceText:string; FirstSign:string; LastSign:string):string;
var sstart,send,t:integer;
    sourcecopy:string;
begin
t:=postext(SourceText,FirstSign);
if t=0 then begin result:=''; exit; end;
sstart:=t+length(FirstSign);
sourcecopy:=copy(SourceText,sstart,length(SourceText)-sstart+1);
send:=postext(sourcecopy,LastSign);
if send=0 then begin result:=''; exit; end;
Result:=copy(sourcecopy,1,send-1);
{sstart:=sstart+length(FirstSign)-1;
SourceText[sstart]:='?';
send:=postext(SourceText,LastSign);
Result:=copy(Sourcetext,sstart+1,send-sstart-1);}
end;

function TStr.GetField(SourceText:string; Separator:char; Index:integer):string;
var i,i1:integer;
begin
i1:=1;
Result:='';
i:=length(SourceText);
if i<2 then
begin
Result:='';
exit;
end;
i:=1;
while i-1<Index do
  begin
  if SourceText[i1]=Separator then begin inc(i); if i-1<Index then Result:=''; end;
  if Sourcetext[i1]<>Separator then Result:=Result+SourceText[i1];
  inc(i1);
  end;
end;

function TStr.DestroyChars(SourceText:string; Char:char):string;
var i:integer;
begin
Result:='';
for i:=1 to length(SourceText) do
begin
if SourceText[i]<>Char then Result:=Result+SourceText[i];
end;

end;

function TStr.GetAndDeleteLine(var SourceText:string):string;
var i:integer;
begin
i:=1;
Result:='';
while (SourceText[i]<>#$d) and (SourceText[i+1]<>#$a) do
begin
Result:=Result+SourceText[i];
inc(i);
if i>length(SourceText) then begin Result:=''; exit; end;
end;
i:=i+2;
SourceText:=fastmidstr(SourceText,i,length(SourceText)-i+1);
end;

function TStr.CutIncludeTextTo(SourceText:string; CutTo:string):string;
var i:integer;
begin
Result:='';
i:=postext(SourceText,CutTo);
i:=i+length(CutTo);
if i=0 then begin Result:='NOTFOUND'; exit; end;
Result:=midstr(SourceText,i,length(SourceText)-i+1);
end;

function TStr.CutTextTo(SourceText, CutTo: string): string;
var i:integer;
begin
Result:='';
if (SourceText='') or (CutTo='') then exit;
i:=postext(SourceText,CutTo);
if i=0 then begin Result:='NOTFOUND'; exit; end;
Result:=midstr(SourceText,i,length(SourceText)-i+1);
end;

function TStr.PosText(SourceText:string; SearchString:string):integer;
var i:integer;
begin
i:=1;
result:=0;
while i<(length(SourceText)-length(SearchString)) do
begin
if SourceText[i]=SearchString[1] then
if copy(sourcetext,i,length(Searchstring))=SearchString then begin Result:=i; break; end;
inc(i);
end;  //while i<length(SourceText)

end;

function TStr.GetFieldbyRandomText(SourceText, FieldName: string;
  FieldIndex: integer): string;
var i,i1:integer;
    s:string;
begin
//get field from string
s:=Sourcetext;
i:=0;
while i<FieldIndex do
begin
inc(i);
s:=CutIncludeTextTo(s,Fieldname);
end;
i1:=postext(s,#13);
Result:=copy(s,1,i1-1);
end;

function TStr.str2int(Number: string): integer;
begin
try
Result:=strtoint(Number);
except
Result:=0;
end;
end;

function TStr.HexToStr(Hex: string): string;
var i:integer;
    s:string;
begin
i:=1; s:='';
while (i<=length(hex)) do
begin
s:=s+chr(strtoint('$'+hex[i]+hex[i+1]));
i:=i+2;
end;
Result:=s;
end;

function TStr.StrToHex(Str: string): string;
var i:integer;
    s:string;
begin
i:=1; s:='';
while (i<=length(str)) do
begin
s:=s+inttohex(ord(Str[i]),2);
inc(i);
end;
Result:=s;
end;

function TStr.GetAndCutText(var SourceText: string; CutTo: string): string;
var i:integer;
begin
Result:='';
if (SourceText='') or (CutTo='') then exit;
i:=postext(SourceText,CutTo);
if i=0 then begin Result:=''; exit; end;
Result:=copy(SourceText,1,i-1);
i:=i+length(CutTo);
SourceText:=copy(SourceText,i,length(SourceText)-i+1);
end;

function TStr.CutTextToFastChar(SourceText, CutTo: string): string;
var i:integer;
begin
if (SourceText='') or (CutTo='') then exit;
i:=pos(CutTo, SourceText);
if i=0 then begin Result:=''; exit; end;
Result:=copy(SourceText,i,length(SourceText)-i+1);
end;

function TStr.HextoBinFast(Value: String): String;
var i:integer;
    num:string;
    output:string;
begin
output:='';
for i:=1 to length(value) div 2 do
begin
num:=Value[(i*2)-1]+Value[(i*2)];
output:=output+chr(strtoint('$'+num));
end;
Result:=output;
end;

{ TDialogs }

function TDialogs.Open: string;
var Dialog:TOpenDialog;
begin
Dialog:=TOpenDialog.Create(nil);
if Dialog.Execute then
begin
Result:=Dialog.FileName;
end
else
Result:='';
Dialog.Free;
end;

function TDialogs.Save:string;
var Dialog:TSaveDialog;
begin
Dialog:=TSaveDialog.Create(nil);
if Dialog.Execute then
begin
Result:=Dialog.FileName;
end
else
Result:='';
Dialog.Free;
end;

{ TFiles }

function TFiles.Read(Filename: string): string;
var fh,fl:integer;
    buffer:pchar;
begin
if Filename='' then exit;
fh:=FileOpen(Filename,fmOpenRead);
if fh=-1 then begin result:=''; exit; end;
fl:=FileSeek(fh,0,2);
FileSeek(fh,0,0);
buffer:=pchar(allocmem(fl+1));
FileRead(fh,buffer^,fl);
FileClose(fh);
result:=buffer;
SysFreeMem(Buffer);
end;

procedure TFiles.Save(Filename:string; Buffer: string);
var fh:integer;
    pbuffer:pchar;
begin
if Filename='' then exit;
fh:=FileCreate(Filename);
pbuffer:=pchar(buffer);
FileWrite(fh,pbuffer^,Length(Buffer));
FileClose(fh);
end;

procedure TFiles.Append(Filename:string; Buffer: string);
var fh:integer;
    pbuffer:pchar;
begin
if Filename='' then exit;
fh:=FileOpen(Filename,fmOpenWrite);
pbuffer:=pchar(buffer);
FileWrite(fh,pbuffer^,Length(Buffer));
FileClose(fh);
end;

function TDatabase.MySqlGetQuery(ip, user, pass, db, query: string): boolean;
begin
Result:=false;
			MySQLLib := mysql_init(nil);
			if MySQLLib = nil then begin MySQLError:='Library access error'; exit; end;

			try
			if mysql_options(MySQLLib, MYSQL_OPT_CONNECT_TIMEOUT, '1') <> 0 then begin MySQLError:='OPTIONS SET ERROR: '+mysql_error(MySQLLib); exit; end;
			if mysql_options(MySQLLib, MYSQL_OPT_COMPRESS, '0') <> 0 then begin MySQLError:='OPTIONS SET ERROR: '+mysql_error(MySQLLib); exit; end;
			if mysql_options(MySQLLib, MYSQL_OPT_READ_TIMEOUT, '1') <> 0 then begin MySQLError:='OPTIONS SET ERROR: '+mysql_error(MySQLLib); exit; end;
			if mysql_options(MySQLLib, MYSQL_OPT_WRITE_TIMEOUT, '1') <> 0 then begin MySQLError:='OPTIONS SET ERROR: '+mysql_error(MySQLLib); exit; end;
			if mysql_real_connect(MySQLLib, pChar(ip), pChar(user), pChar(pass), pchar(db), 3306, nil, 0) = nil then begin MySQLError:='MYSQL CONNECT ERROR: '+mysql_error(MySQLLib); exit; end;
      if mysql_real_query(MySQLLib, pChar(Query), length(Query)) <> 0 then begin MySQLError:='QUERY ERROR: '+mysql_error(MySQLLib); exit; end;

      QResult := mysql_store_result(MySQLLib);
      if QResult = nil then begin MySQLError:='No result set'; Result:=true; exit; end;
      Fields := mysql_fetch_fields(QResult);
      FieldCount := mysql_field_count(MySQLLib);
      RowCount := mysql_num_rows(QResult);
      except
      MySQLError:='Unknown ERROR';
      exit;
      end;

Result:=true;
end;

function TDatabase.MySqlSeekFirstRow: boolean;
begin
result:=true;
try
mysql_data_seek(QResult, 0);
except
result:=false;
end;
end;

function TDatabase.MySqlGetRow: boolean;
begin
Row := mysql_fetch_row(QResult);
if row=nil then result:=false else result:=true;
end;

function TDatabase.MySqlClose: boolean;
begin
mysql_close(MySQLLib);
Result:=true;
end;

function TDatabase.MySqlQuery(query: string): boolean;
begin
Result:=false;

      try
      if mysql_real_query(MySQLLib, pChar(Query), length(Query)) <> 0 then begin MySQLError:='QUERY ERROR'; exit; end;
      QResult := mysql_store_result(MySQLLib);
      if QResult = nil then begin MySQLError:='No result set'; Result:=true; exit; end;
      Fields := mysql_fetch_fields(QResult);
      FieldCount := mysql_field_count(MySQLLib);
      RowCount := mysql_num_rows(QResult);
      except
      MySQLError:='Unknown ERROR';
      exit;
      end;

Result:=true;
end;

end.