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-1Separator 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 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.