|
{ Please note this was a one time code used for creation of file for Palm handheld. It is provided as-is, for demonstration purposes. Project was never commercialized. Igor Klepoch, 2001 } unit CrackSlov; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, Buttons, Db, DBTables, Grids, DBGrids, ComCtrls, FileUtil; const PocetSlov = 32; type tZnak = object znak : char; pocet : integer; pocetnost : real; kod : string [20]; end; tPalmZipTab = object kod : array [1..4] of byte; znak : char; dlzka : byte; end; TForm1 = class(TForm) BitBtn1: TBitBtn; BitBtn2: TBitBtn; bbVymaz: TBitBtn; Label1: TLabel; DataSource1: TDataSource; qSlov: TQuery; eHladaj: TEdit; DBGrid1: TDBGrid; BitBtn3: TBitBtn; BitBtn4: TBitBtn; ProgressBar1: TProgressBar; tSlov: TTable; tSlovAn: TStringField; tSlovSlov: TStringField; tSlovVyb: TStringField; eFound: TEdit; SpeedButton1: TSpeedButton; SpeedButton2: TSpeedButton; qPom: TQuery; DataSource2: TDataSource; SpeedButton3: TSpeedButton; SpeedButton4: TSpeedButton; sbCisti: TSpeedButton; qSlovan: TStringField; qSlovslov: TStringField; qSlovvyb: TStringField; qSlovID: TIntegerField; qPom2: TQuery; DataSource3: TDataSource; SpeedButton5: TSpeedButton; SpeedButton6: TSpeedButton; SpeedButton7: TSpeedButton; SpeedButton8: TSpeedButton; procedure BitBtn1Click(Sender: TObject); procedure BitBtn2Click(Sender: TObject); procedure bbVymazClick(Sender: TObject); procedure BitBtn3Click(Sender: TObject); procedure BitBtn4Click(Sender: TObject); procedure FormCreate(Sender: TObject); procedure DBGrid1DblClick(Sender: TObject); procedure SpeedButton1Click(Sender: TObject); procedure SpeedButton2Click(Sender: TObject); procedure SpeedButton3Click(Sender: TObject); procedure SpeedButton4Click(Sender: TObject); procedure sbCistiClick(Sender: TObject); procedure SpeedButton5Click(Sender: TObject); procedure SpeedButton6Click(Sender: TObject); procedure SpeedButton7Click(Sender: TObject); procedure SpeedButton8Click(Sender: TObject); private stahuj : boolean; vyskytov : array[0..255] of tznak; CSuc : real; procedure ConvertData; procedure RunSql (SqlPr : string); procedure OpenSql (SqlPr : string; Otv : TQuery = nil); procedure VytvorTabKodov; procedure ZapisTab; procedure ZapisVybpol; procedure KodujPol (KStr : string; F : TStream); { Private declarations } public { Public declarations } end; var Form1: TForm1; AdrApl, DataAdr : string; PAdresa : array [0..100] of char; PocetRiadkov : integer; MaxSize : integer; PocANSLovo : string; implementation uses ShellAPI, sndkey32, clipbrd, PDBLibr, StrUtils, Math; {$R *.DFM} procedure TForm1.BitBtn1Click(Sender: TObject); var PDir, parms : array[0..1] of char; PAdresa : array [0..100] of char; str, odp, odp1, Adresa : string; i, k : integer; hw : HWND; z : TDAtetime; procedure MWait; var i, j : integer; begin for i := 0 to 400000 do begin j := i + 1; end; end; function CitajClip (Cit : pchar; predch : string = '*') : string; var i : integer; modp : string; begin i := 0; clipboard.AsText := '*'; SendKeys(cit, true); Application.ProcessMessages; // MWait; try modp := clipboard.AsText; except modp := '*'; end; while (i < 20) and (modp = '*') do begin Application.ProcessMessages; // MWait; try modp := clipboard.AsText; except modp := '*'; end; end; result := clipboard.AsText; end; begin Adresa := 'D:\translat\wtrdict'; STRPCopy(PAdresa, Adresa); hw := ShellExecute (Form1.Handle, 'open', PAdresa, parms, PDir, SW_SHOWNORMAL); for k:= 1 to 1000 do MWait; z := time(); for k:= 1 to 1000 do MWait; Application.ProcessMessages; z := time(); stahuj := true; i := 1; if eHladaj.text > '' then begin str := eHladaj.text + '~'; STRPCopy(PAdresa, str); SendKeys(PAdresa, true); end; Application.ProcessMessages; // MWait; while stahuj do begin odp := CitajClip('^i'); odp1 := CitajClip ('%o^i%o', odp); SendKeys('{down}', true); Application.ProcessMessages; MWait; TSlov.Append; TSlovAn.AsString := odp1; TSlovSlov.AsString := odp; TSlov.post; Application.ProcessMessages; // MWait; inc (i); Label1.Caption := IntToStr (i); Application.ProcessMessages; end; z := time() - z; Label1.caption := TimeToStr (z); label1.refresh; qSlov.close; qSlov.open; end; procedure TForm1.BitBtn2Click(Sender: TObject); begin stahuj := false; end; procedure TForm1.bbVymazClick(Sender: TObject); begin if MessageDlg('Skutočne chcete vymazať databázu ?', mtError, [mbYes, mbNo], 0) = mrYes then with QSlov do begin close; sql.clear; sql.add('delete from slovnik'); ExecSQL; close; end; end; procedure TForm1.BitBtn3Click(Sender: TObject); var f : textfile; mtext : string; begin AssignFile(F, 'slov.txt'); Rewrite(F); with TSlov do begin first; while not(eof) do begin mtext := '"' + TSlovAn.AsString + '", "' + TSlovSlov.AsString + '"'; Writeln(F, mtext); next; end; end; CloseFile(F); end; procedure TForm1.BitBtn4Click(Sender: TObject); var FSIn, FSOut : TFileStream; FSLog : TFileStream; FSOut1, FSOut2 : TMemoryStream; OfsOdZac, IDRec : Int64; EndRec : array [0..3] of byte; i, j, OutVal : integer; PocRec, PocSlVRec : integer; PocSlVRecPoz: word; procedure ZapisDBSubor; var ZapStr : string; Poz : integer; procedure ZapisDlzku; var ADlzka : word; begin if PocSlVRec = 0 then begin PDBWriteInt4(OfsOdZac, FSOut); // hlavicka pre PALM - novy record PDBWriteInt4(IDRec, FSOut); PocSlVRecPoz := (PocetSlov - 1) * 2; // prve slovo za tabulku dlzkok slov Poz := 0; PocANSLovo := copy(ZapStr, 1, 100); end else PDBWriteInt2 (PocSlVRecPoz, FSOut1); inc (PocSlVRec); KodujPol (ZapStr, FSOut2); ADlzka := (FSOut2.Position - Poz); PocSlVRecPoz := PocSlVRecPoz + ADlzka; Poz := FSOut2.Position; if PocSlVRec = PocetSlov then begin PocANSLovo := IntToStr(FSOut2.Size + (PocetSlov - 1) * 2) + ' - ' + PocANSLovo + #13#10; PDBWriteString (PocANSLovo, FSLog); MaxSize := max (MaxSize, FSOut2.Size); OfsOdZac := OfsOdZac + FSOut2.Size + (PocetSlov - 1) * 2; PocSlVRec := 0; FSOut2.Position := 0; FSOut1.CopyFrom (FSOut2, FSOut2.size); FSOut2.Clear; end; ZapStr := ''; end; function MStrBinToWord (vst : string) : Longword; var vysl, AddVal : Longword; p: integer; AVal, AAddVal : integer; begin vysl := 0; AddVal := 1; p := 1; while p <= length(vst) do begin if vst[p] = '1' then vysl := vysl + AddVal; AddVal := AddVal * 2; inc (p); end; result := vysl; end; procedure ZapisKodTable; var i : integer; AddRec : tPalmZipTab; AKod : Longword; c1, c2 : word; begin i := 0; Poz := FSOut1.Position; while (i <= 255) and (vyskytov [i].pocet > 0) do with vyskytov [i] do begin AddRec.znak := vyskytov [i].znak; AddRec.dlzka := Length(vyskytov [i].kod); AKod := MStrBinToWord (vyskytov [i].kod); c1 := AKod div 65536; c2 := AKod mod 65536; AddRec.kod [1] := Hi (c1); AddRec.kod [2] := Lo (c1); AddRec.kod [3] := Hi (c2); AddRec.kod [4] := Lo (c2); FSOut1.Write (AddRec, SizeOf (tPalmZipTab)); inc (i); end; PDBWriteInt4(OfsOdZac, FSOut); PDBWriteInt4(IDRec, FSOut); inc(IDRec); OfsOdZac := OfsOdZac + (FSOut1.Position - Poz); Poz := FSOut1.Position; end; begin inc (PocRec); PDBWriteInt2(PocRec, FSOut); OfsOdZac := FSOut.Size; OfsOdZac := OfsOdZac + PocRec * 8; ZapisKodTable; PocSlVRec := 0; // stream 2 na slova FSOut2 := TMemoryStream.create; PocSlVRec := 0; with qSlov do begin first; ZapStr := ''; while not(eof) do begin if qSlovvyb.asstring = '*' then begin if ZapStr > '' then ZapisDlzku; ZapStr := ZapStr + qSlovAn.AsString + #0 + qSlovSlov.AsString + #0; end else ZapStr := ZapStr + qSlovSlov.AsString + #0; inc(IDRec); next; end; // PocetZapRec := 10000; ZapisDlzku; ZapStr := ''; while (PocSlVRec > 0) do ZapisDlzku; end; end; begin VytvorTabKodov; qSlov.DisableControls; qpom.close; qpom.sql.clear; qpom.sql.add ('select count(*) from slovnik where vyb = "*"'); qpom.open; PocRec := qpom.Fields[0].AsInteger; if (PocRec mod PocetSlov) > 0 then PocRec := PocRec div PocetSlov + 1 else PocRec := PocRec div PocetSlov; qpom.close; qSlov.sql.clear; qSlov.sql.add ('select slovnik.*, UPPER(an + " " + slov) as AN1 from slovnik ORDER BY AN1'); qSlov.open; IDRec := $40CF9001; EndRec [0] := $40; EndRec [1] := $CF; EndRec [2] := $90; EndRec [3] := $01; MaxSize := 0; try FSLog := TFileStream.create ('log.txt', fmCreate); FSOut := TFileStream.create (AdrApl + 'data\SlovnikDB.pdb', fmCreate); FSOut1 := TMemoryStream.create; try FSIn := TFileStream.create (AdrApl + 'data\a.pdb', fmOpenRead); FSOut.CopyFrom (FSIn, FSIn.size); finally FSIn.Free; ZapisDBSubor; FSOut1.Position := 0; FSOut.CopyFrom (FSOut1, FSOut1.size); end; finally j := FSOut.size mod 16 + 1; OutVal := 0; for i:= j to 16 do FSOut.Write (OutVal, 1); FSOut.free; FSOut1.free; FSLog.free; qSlov.close; qSlov.sql.clear; qSlov.sql.add ('select * from slovnik'); qSlov.open; qSlov.EnableControls; MessageDlg('Súbor je vytvorený'+#13+#10+'Počet riadkov :' + IntToStr(PocRec) + 'Max record = ' + IntToStr(MaxSize), mtInformation, [mbOK], 0); end; end; procedure TForm1.FormCreate(Sender: TObject); begin AdrApl := ExtractFilePath (Application.exeName); DataAdr := AdrApl + 'data\'; tSlov.DatabaseName := DataAdr; tSlov.open; qSlov.DatabaseName := DataAdr; qPom.DatabaseName := DataAdr; qSlov.open; end; procedure TForm1.DBGrid1DblClick(Sender: TObject); function PosunVyber (VstS : string) : string; begin if VstS = '' then result := '*' else if VstS = '*' then result := '+' else result := ''; end; begin qSlov.edit; qSlov.FieldByName('Vyb').AsString := PosunVyber(qSlov.FieldByName('Vyb').AsString); Qslov.post; end; procedure TForm1.SpeedButton1Click(Sender: TObject); begin qSlov.Locate ('An', eFound.text, [loPartialKey]); eFound.text := ''; end; procedure TForm1.SpeedButton2Click(Sender: TObject); var fWord : string; begin if qSlov.FieldByName('Vyb').AsString = '' then begin qSlov.Edit; qSlov.FieldByName('Vyb').AsString := '*'; fWord := qSlov.FieldByName('An').AsString; if pos(' ', TRIM(fWord)) > 0 then fWord := copy(fWord, 1, pos(' ', TRIM(fWord))); qSlov.post; qSlov.next; while fWord = qSlov.FieldByName('An').AsString do begin qSlov.Edit; qSlov.FieldByName('Vyb').AsString := '+'; qSlov.post; qSlov.next; end; end; end; function ToIsteSlovo(sl1, sl2 : string) : boolean; begin sl2 := UPPERCASE(sl2); if sl1 = sl2 then result := true else if length(sl1) > 1 then begin sl2 := copy(sl2, length(sl1) + 1, length(sl2)); result := IsInSet (sl2, ['-', ' ', 'ED', 'ING', 'S']); end else result := false; end; procedure TForm1.SpeedButton3Click(Sender: TObject); var fWord : string; poc : integer; begin with qSlov do begin RunSql('update slovnik set vyb = ""'); qSlov.DisableControls; first; while not(eof) do begin RunSql('update slovnik set vyb = "*" where ID = ' + qSlovID.AsString); fWord := UPPERCASE(qSlov.FieldByName('An').AsString); if pos(' ', TRIM(fWord)) > 0 then fWord := copy(fWord, 1, pos(' ', TRIM(fWord))); next; while ToIsteSlovo(fWord, FieldByName('An').AsString) and (not(eof)) do begin RunSql('update slovnik set vyb = "+" where ID = ' + qSlovID.AsString); next; end; inc (poc); end; MessageDlg('ok', mtInformation, [mbOK], 0); end; qSlov.EnableControls; end; procedure TForm1.SpeedButton4Click(Sender: TObject); begin if MessageDlg('Chceš mazať ???', mtWarning, [mbYes, mbNo], 0) = mrYes then with qPom do begin close; sql.clear; sql.add ('delete from slovnik'); ExecSQL; qSlov.close; qSlov.open; end; end; procedure TForm1.sbCistiClick(Sender: TObject); begin tSlov.close; qSlov.close; CopyFile ('data\slovniky\slovnikKompletny.DB', 'data\slovnik.db', ProgressBar1); ConvertData; tSlov.open; qSlov.open; end; procedure TForm1.RunSql (SqlPr : string); begin with qPom do begin close; sql.clear; sql.add (SqlPr); ExecSQL; end; end; procedure TForm1.OpenSql (SqlPr : string; Otv : TQuery = nil); begin if not(assigned(Otv)) then Otv := qPom; with Otv do begin close; sql.clear; sql.add (SqlPr); open; end; end; procedure TForm1.ConvertData; var Posl, PoslSl, PoslAN : string; poc, PocPrekl : integer; begin RunSql('delete from DelID'); RunSql('update slovnik set an = substring(an from 3) where substring(an from 1 for 2) = ''a '''); RunSql('update slovnik set an = substring(an from 4) where substring(an from 1 for 3) = ''to '''); OpenSql('select * from slovnik order by an, slov', qPom2); poc := 0; with qpom2 do begin first; PoslSl := fieldByName ('slov').AsString; PoslAN := fieldByName ('an').AsString; Posl := PoslSl + PoslAN; PoslSl := copy(PoslSl, 1, length(PoslSl) - 1); PocPrekl := 0; next; while not(eof) do begin if pos(' ', TRIM(fieldByName ('an').AsString)) > 0 then RunSql('insert into delID values (' + fieldByName ('ID').AsString + ')') else if Posl = fieldByName ('an').AsString + fieldByName ('slov').AsString then RunSql('insert into delID values (' + fieldByName ('ID').AsString + ')') else if PoslSl = copy(fieldByName ('slov').AsString, 1, length(PoslSl)) then RunSql('insert into delID values (' + fieldByName ('ID').AsString + ')') else if PocPrekl > 5 then RunSql('insert into delID values (' + fieldByName ('ID').AsString + ')'); if PoslAN = fieldByName ('an').AsString then inc (PocPrekl) else PocPrekl := 0; PoslSl := fieldByName ('slov').AsString; PoslAN := fieldByName ('an').AsString; Posl := PoslSl + PoslAN; PoslSl := copy(PoslSl, 1, length(PoslSl) - 1); inc (poc); label1.caption := IntToStr(poc); label1.refresh; next; end; end; end; procedure TForm1.ZapisTab; var F : TexTfile; i : integer; dlzka : integer; begin AssignFile(F, 'tab.txt'); Rewrite(F); dlzka := 0; i := 0; while (i <= 255) and (vyskytov [i].pocet > 0) do with vyskytov [i] do begin dlzka := dlzka + pocet * length (trim(kod)); Writeln (F, znak + ' ' + kod + ' ' + IntToStr(pocet) + ' ' + FloatToStr (pocetnost)); inc (i); end; Writeln (F, 'celkova dlzka : ' + IntToStr(dlzka)); Writeln (F, 'znakov : ' + FloatToStr(CSuc)); CloseFile(F); end; procedure TForm1.KodujPol (KStr : string; F : TStream); var i : integer; vysl : string; procedure StrToBin (vst : string); var vysl : string; p: integer; AVal, AAddVal : integer; begin while length(vst) mod 8 > 0 do vst := vst + '1'; p := 1; while p < length(vst) do begin AAddVal := 1; AVal := 0; while AAddVal < 256 do begin if vst[p] = '1' then Aval := AVal + AAddVal; AAddVal := AAddVal * 2; inc (p); end; f.Write (AVal, 1); end; end; function NajdiZnak (Zn : char) : string; var j : integer; begin j := 0; while (j <= 255) and (vyskytov [j].znak <> Zn) do inc (j); result := vyskytov [j].kod; end; begin vysl := ''; for i := 1 to length(KStr) do vysl := vysl + NajdiZnak(KStr[i]); StrToBin(vysl); end; procedure TForm1.SpeedButton5Click(Sender: TObject); begin VytvorTabKodov; ZapisTab; ZapisVybpol; end; procedure TForm1.ZapisVybpol; var F1 : TexTfile; FSOut : TFIleStream; NSlovo : string; n, poc : integer; OddelZn : word; begin FSOut := TFileStream.create ('kod.bin', fmCreate); OddelZn := $feff; try AssignFile(F1, 'vybrslova.txt'); Rewrite(F1); with qSlov do begin first; poc := 0; while not(eof) and (poc < 10000) do begin KodujPol(FieldByName('an').AsString + #0 + FieldByName('slov').AsString + #0, FSOut); FSOut.Write (OddelZn, 2); Writeln (F1, FieldByName('an').AsString + FieldByName('slov').AsString); inc (poc); MoveBy(10); // only sampling is needed, hence every 10th word is used end; end; finally FSOut.free; CloseFile(F1); end; end; procedure TForm1.VytvorTabKodov; var nHodn : tZnak; TopPol, poc, i : integer; AStr : string; BolaVymena : boolean; procedure PridelKody; var AKod, AktHodn, MaxHodn : integer; AUroven : real; TopPol, PocZn : integer; begin MaxHodn := 2; AUroven := 0.5; TopPol := 0; AktHodn := 0; PocZn := 1; while vyskytov [TopPol].pocet > 0 do begin while (vyskytov [TopPol].pocet > 0) and (vyskytov [TopPol].pocetnost >= AUroven) and (AktHodn <= MaxHodn) do begin vyskytov [TopPol].kod := IntToBin (AktHodn, PocZn, 20); inc (TopPol); inc (AktHodn); end; if AktHodn > MaxHodn then begin MaxHodn := 2; AUroven := 0.5; TopPol := 0; AktHodn := 1; PocZn := 1; end else begin AUroven := AUroven / 2; MaxHodn := MaxHodn * 2; AktHodn := AktHodn * 2; inc(PocZn); end; end; end; begin for i := 0 to 255 do with vyskytov [i] do begin pocet := 0; znak := chr(i); end; with qSlov do begin disableControls; first; poc := 0; while not(eof) and (poc < 10000) do begin AStr := FieldByName('an').AsString + FieldByName('slov').AsString; for i := 1 to length(AStr) do inc (vyskytov[ORD(AStr[i])].pocet); inc (poc); MoveBy(10); end; end; vyskytov [0].pocet := poc * 2; CSuc := 0; for i := 0 to 255 do CSuc := CSuc + vyskytov [i].pocet; for i := 0 to 255 do with vyskytov [i] do if pocet > 0 then pocetnost := pocet / CSuc else pocetnost := 0; BolaVymena := true; while BolaVymena do begin i := 0; BolaVymena := false; while i < 255 do begin if vyskytov [i + 1].pocet > vyskytov [i].pocet then begin nHodn := vyskytov [i + 1]; vyskytov [i + 1] := vyskytov [i]; vyskytov [i] := nHodn; BolaVymena := true; end; inc(i); end; end; TopPol := 0; PridelKody; qPom.enableControls; end; procedure TForm1.SpeedButton6Click(Sender: TObject); function DecodeLine (f : TfileStream) : string; var a, vysl, DecStr : string; j : integer; function MBinToStr : string; var vysl : string; i : integer; NZn, NZn1 : byte; koniec : boolean; begin vysl := ''; koniec := false; if f.read (NZn, 1) > 0 then while not(koniec) do begin if NZn < 255 then begin vysl := vysl + TRIM(IntToBin (NZn, 8, 8)); f.read (NZn, 1); end else begin f.read (NZn1, 1); if NZn1 = 254 then koniec := true else begin vysl := vysl + TRIM(IntToBin (NZn, 8, 8)); vysl := vysl + TRIM(IntToBin (NZn1, 8, 8)); end; end; end; result := vysl; end; begin DecStr := MBinToStr; vysl := ''; while length(DecStr) > 0 do begin j := 0; while (j <= 255) and (copy(DecStr, 1, length(vyskytov [j].kod)) <> vyskytov [j].kod) do begin inc (j); end; if length(vyskytov [j].kod) = 0 then break; vysl := vysl + vyskytov [j].znak; DecStr := copy(DecStr, length(vyskytov [j].kod) + 1, length(DecStr)); end; result := vysl; end; var F1 : TexTfile; FSIN : TFIleStream; ALine : string; begin FSIN := TFileStream.create ('kod.bin', fmOpenRead ); try AssignFile(F1, 'dekod.txt'); Rewrite (f1); ALine := DecodeLine (FSIN); while ALine > '' do begin writeln(F1, ALine); ALine := DecodeLine (FSIN); end; finally FSIN.Free; CloseFile(F1); end; end; procedure TForm1.SpeedButton7Click(Sender: TObject); var JeSl : boolean; begin with qSlov do begin close; sql.clear; sql.add ('select slovnik.*, UPPER(an) as AN1 from slovnik where vyb > "" ORDER BY AN1'); open; end; qSlov.DisableControls; with qSlov do begin first; MoveBy(2); JeSl := false; while not(eof) do begin if qSlovvyb.asstring = '*' then begin if JeSl then begin MoveBy(20); JeSl := false; end else begin RunSql('insert into DelID values (' + qSlovID.AsString + ')'); JeSl := true; end; end else if JeSl then RunSql('insert into DelID values (' + qSlovID.AsString + ')'); next; end; end; qSlov.EnableControls; end; function MStrBinToStr (vst : string) : string; var vysl : string; p: integer; AVal, AAddVal : integer; begin while length(vst) mod 8 > 0 do vst := '0' + vst; p := 1; AVal := 0; while p < length(vst) do begin AAddVal := 128; while AAddVal > 0 do begin if vst[p] = '1' then Aval := AVal + AAddVal; AAddVal := AAddVal div 2; inc (p); end; end; result := IntToStr(AVal) end; procedure TForm1.SpeedButton8Click(Sender: TObject); var F : TexTfile; i : integer; Vysl : string; begin VytvorTabKodov; AssignFile(F, 'palm.txt'); Rewrite(F); try i := 0; while (i <= 255) and (vyskytov [i].pocet > 0) do with vyskytov [i] do begin Vysl := 'AddArray (' + MStrBinToStr(copy(kod, 1, 8)) + ',' + MStrBinToStr(copy(kod, 9, 8)) + ',' + MStrBinToStr(copy(kod, 17, 8)) + ', ''' + znak + ''', ' + IntToStr(length(kod)) + '); // ' + IntToStr(i); Writeln (f, Vysl); inc (i); end; finally CloseFile(F); end; end; end. ------------------------------------------- unit PDBLibr; interface uses Classes, SysUtils; procedure PDBWriteInt2 (Cislo : word; var F: TMemoryStream); overload; procedure PDBWriteInt2 (Cislo : word; var F: TFileStream); overload; procedure PDBWriteInt4 (Cislo : Int64; var F: TFileStream); procedure PDBWriteString (ZapStr : string; var F: TFileStream); function IsInSet (SearchVal : string; MSet : array of string) : boolean; implementation procedure PDBWriteInt2 (Cislo : word; var F: TMemoryStream); var VCislo : array[0..1] of byte; begin VCislo[0] := Hi(Cislo); VCislo[1] := Lo(Cislo); f.Write (VCislo, 2); end; procedure PDBWriteInt2 (Cislo : word; var F: TFileStream); var VCislo : array[0..1] of byte; begin VCislo[0] := Hi(Cislo); VCislo[1] := Lo(Cislo); f.Write (VCislo, 2); end; procedure PDBWriteInt4 (Cislo : Int64; var F: TFileStream); var VCislo : array[0..8] of byte; i : integer; c1, c2 : word; begin c1 := Cislo div 65536; c2 := Cislo mod 65536; VCislo[0] := Hi(c1); VCislo[1] := Lo(c1); VCislo[2] := Hi(c2); VCislo[3] := Lo(c2); f.Write (VCislo, 4); end; procedure PDBWriteString (ZapStr : string; var F: TFileStream); var ZS : array[0..1000] of char; dlzka : integer; begin STRPCopy(ZS, ZapStr); dlzka := length(ZapStr) + 1; f.Write (ZS, dlzka); end; function IsInSet (SearchVal : string; MSet : array of string) : boolean; var i : integer; begin result := false; for i:= 0 to High (MSet) do if (MSet[i] = SearchVal) then result := true; end; end.