Login | ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/decoder/trunk/Quelltext/Main.pas
Revision: 2
Committed: Thu Nov 8 11:09:30 2018 UTC (23 months, 3 weeks ago) by daniel-marschall
Content type: text/x-pascal
File size: 120550 byte(s)
Log Message:
Published revision 01 March 2007 to SVN.
Added disclaimer.
Changed the license to Apache2.

File Contents

# User Rev Content
1 daniel-marschall 2 unit Main;
2    
3     interface
4    
5     uses
6     Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, DECUtil,
7     DECHash, DECCipher, registry, KAZip, shlobj, StdCtrls, math,
8     shellapi, Buttons, ComCtrls, ExtCtrls, inifiles, DragDropFile, DragDrop,
9     ImgList, base64, ZLib, wininet, OneInst, DCConst, Dialogs,
10     Menus{, XPMenu};
11    
12     type
13     TCase = (tcUnknown, tcEncrypted, tcDecrypted);
14    
15     TProgress = class(TInterfacedObject, IDECProgress)
16     procedure Process(const Min, Max, Pos: Int64); stdcall;
17     constructor Create;
18     destructor Destroy; override;
19     end;
20    
21     TMainForm = class(TForm)
22     dlg_open: TOpenDialog;
23     dlg_save_dec: TSaveDialog;
24     dlg_save_enc: TSaveDialog;
25     tmr_capslock: TTimer;
26     img_type: TImage;
27     lbl_vle1: TLabel;
28     edt_vle1: TEdit;
29     edt_vle2: TEdit;
30     lbl_vle2: TLabel;
31     lbl_vle3: TLabel;
32     edt_vle3: TEdit;
33     lbl_vle4: TLabel;
34     edt_vle4: TEdit;
35     lbl_vle5: TLabel;
36     edt_vle5: TEdit;
37     lbl_vle6: TLabel;
38     edt_vle6: TEdit;
39     lbl_vle7: TLabel;
40     edt_vle7: TEdit;
41     lbl_passwort: TLabel;
42     edt_passwort: TEdit;
43     lbl_passwort2: TLabel;
44     edt_passwort2: TEdit;
45     img_warning: TImage;
46     lbl_capswarning: TLabel;
47     chk_securedelete: TCheckBox;
48     lbl_entropy: TLabel;
49     lbl_equal: TLabel;
50     imagelist: TImageList;
51     img_error: TImage;
52     lbl_readerror: TLabel;
53     b_encrypt: TBitBtn;
54     b_decrypt: TBitBtn;
55     b_direct: TBitBtn;
56     b_open: TBitBtn;
57     b_folder: TBitBtn;
58     chk_compress: TCheckBox;
59     tmr_refresh: TTimer;
60     mainmenu: TMainMenu;
61     mm_file: TMenuItem;
62     m_open: TMenuItem;
63     m_folder: TMenuItem;
64     seperator1: TMenuItem;
65     m_config: TMenuItem;
66     seperator2: TMenuItem;
67     m_close: TMenuItem;
68     m_exit: TMenuItem;
69     mm_actions: TMenuItem;
70     mm_help: TMenuItem;
71     m_help: TMenuItem;
72     m_web_update: TMenuItem;
73     m_info: TMenuItem;
74     m_encrypt: TMenuItem;
75     m_decrypt: TMenuItem;
76     m_direct: TMenuItem;
77     seperator5: TMenuItem;
78     m_delete: TMenuItem;
79     m_web: TMenuItem;
80     seperator6: TMenuItem;
81     m_web_dm: TMenuItem;
82     m_web_vts: TMenuItem;
83     m_web_project: TMenuItem;
84     m_web_keytransmitter: TMenuItem;
85     m_web_email: TMenuItem;
86     mm_dateiensammlung: TMenuItem;
87     m_dateiensammlung_add_file: TMenuItem;
88     m_dateiensammlung_show: TMenuItem;
89     m_dateiensammlung_neu: TMenuItem;
90     dlg_open_element: TOpenDialog;
91     seperator3: TMenuItem;
92     seperator4: TMenuItem;
93     m_dateiensammlung_add_folder: TMenuItem;
94     tmp_progressdurchlauf: TTimer;
95     m_web_forum: TMenuItem;
96     m_web_infopages: TMenuItem;
97     procedure form_closequery(Sender: TObject; var CanClose: Boolean);
98     procedure kazip_actions_compress(Sender: TObject; Current, Total: Integer);
99     procedure kazip_actions_decompress(Sender: TObject; Current, Total: Integer);
100     procedure kazip_add(Sender: TObject; ItemName: string);
101     procedure kazip_onchange(Sender: TObject; ChangeType: Integer);
102     procedure kazip_overwrite(Sender:TObject; Var FileName : String; Var Action : TOverwriteAction);
103     procedure tmr_capslock_timer(Sender: TObject);
104     procedure form_create(Sender: TObject);
105     procedure edt_dec_password_keypress(Sender: TObject; var Key: Char);
106     procedure form_close(Sender: TObject; var Action: TCloseAction);
107     procedure dropfile_drop(Sender: TObject; ShiftState: TShiftState;
108     Point: TPoint; var Effect: Integer);
109     procedure edt_password2_change(Sender: TObject);
110     procedure edt_enc_password_keypress(Sender: TObject; var Key: Char);
111     procedure edt_passwort_change(Sender: TObject);
112     procedure edt_passwort2_keypress(Sender: TObject; var Key: Char);
113     procedure m_open_execute(Sender: TObject);
114     procedure m_folder_execute(Sender: TObject);
115     procedure m_config_execute(Sender: TObject);
116     procedure m_exit_execute(Sender: TObject);
117     procedure m_close_execute(Sender: TObject);
118     procedure m_delete_execute(Sender: TObject);
119     procedure m_direct_execute(Sender: TObject);
120     procedure m_encrypt_execute(Sender: TObject);
121     procedure m_decrypt_execute(Sender: TObject);
122     procedure mm_actions_execute(Sender: TObject);
123     procedure mm_file_execute(Sender: TObject);
124     procedure mm_help_execute(Sender: TObject);
125     procedure m_help_execute(Sender: TObject);
126     procedure m_info_execute(Sender: TObject);
127     procedure edt_passwort_keypress(Sender: TObject; var Key: Char);
128     procedure edt_passwort_enter(Sender: TObject);
129     procedure m_web_update_execute(Sender: TObject);
130     procedure form_show(Sender: TObject);
131     procedure tmr_refresh_timer(Sender: TObject);
132     procedure m_web_dm_click(Sender: TObject);
133     procedure m_web_vts_click(Sender: TObject);
134     procedure m_web_project_click(Sender: TObject);
135     procedure m_web_keytransmitter_click(Sender: TObject);
136     procedure m_web_email_click(Sender: TObject);
137     procedure m_dateiensammlung_neu_click(Sender: TObject);
138     procedure m_dateiensammlung_show_click(Sender: TObject);
139     procedure m_dateiensammlung_add_file_click(Sender: TObject);
140     procedure m_dateiensammlung_add_folder_click(Sender: TObject);
141     procedure tmp_progressdurchlauf_timer(Sender: TObject);
142     procedure m_web_forum_click(Sender: TObject);
143     procedure m_web_infopages_click(Sender: TObject);
144     private
145     steuerelementegesperrt: boolean;
146     LangArray: Array of TLanguageEntry;
147     lg_StartFolder: String;
148     temp_unique_number: string;
149     DateienCounter, DateienImOrdner: integer;
150     // Freigegebene Streams, die bei der spontanen Programmbeendigung
151     // unter Abfang der Exceptions freigegeben werden
152     BestimmeDateiGroesseSource: TStream;
153     tempstream: TStream;
154     CompressInputStream, CompressOutputStream: TFileStream;
155     CompressionStream: ZLib.TCompressionStream;
156     DeCompressionStream: ZLib.TDeCompressionStream;
157     ZippingStream: TStream;
158     // Ende
159     procedure progress_position(pos: integer);
160     procedure progress_text(text, item: string);
161     procedure Compress(InputFileName, OutputFileName: string);
162     procedure Decompress(InputFileName, OutputFileName: string);
163     procedure WMCopyData(var Msg: TWMCopyData); message WM_COPYDATA;
164     public
165     // VCL-Ersatz start
166     DropFile: TDropFileTarget;
167     KaZip: TKaZip;
168     //xpmenu: TXPMenu;
169     // VCL-Ersatz ende
170     fileopen: string; // geöffnete datei
171     ersatzname: string; // wenn ein ordner verschlüsselt wird, ordnernamen statt zip-dateinamen angeben
172     ausgabegesetzt: string; // befehlszeile, wenn gesetzt
173     errorlevel: integer; // fehlerlevel für befehlszeilenanwendung
174     flag: byte; // ordner oder datei verschlüsselt?
175     mode: TCase; // status der geöffneten datei?
176     fMenuBrush: TBrush;
177     procedure steuerelementesperren(sperren: boolean);
178     procedure zeige_wartenform(dothis: boolean);
179     function GetLangEntry(name: string): string;
180     procedure OpenFile(fil: string; alternativer_name: string = ''; dateiensammlung: boolean = false);
181     procedure OpenFolder(fol: string);
182     procedure SchliesseDatei();
183     function Unzip(ZipFile, Verzeichnis: string): boolean;
184     procedure zipfolder(verzeichnis, zipname: string);
185     procedure addtozip(fileorfolder, zipfile: string);
186     procedure CreateZipFile(zipfile: string);
187     procedure freestreams();
188     procedure DefaultHandler(var Message); override;
189     procedure ProcessCommandline(lpData: Pointer);
190     procedure Start;
191     function BestimmeDateiGroesse(filename: string): string;
192     end;
193    
194     var
195     MainForm: TMainForm;
196    
197     implementation
198    
199     uses Config, About, Warten, Elemente;
200    
201     {$R *.dfm}
202    
203     {$R WindowsXP.res}
204    
205     const
206     // Konstanten
207     Terminus: String = 'DCTERMINUS';
208     FileNameTerminus: Char = '?';
209     DateiTag: Byte = $00;
210     OrdnerTag: Byte = $01;
211     DateiCompressTag: Byte = $02;
212     OrdnerCompressTag: Byte = $03;
213     TempPre = 'DeCoder_';
214     TempDirect = 'DeCoder_Sensitiv';
215     TempExtTmp = '.tmp';
216     TempExtCmp = '.cmp';
217     TempExtZip = '.zip';
218     ExtDC4 = '.dc4';
219     updateid = 'decoder';
220    
221     // Standardeinstellungen
222    
223     StZIPType: TZipCompressionType = ctNone;
224     ZLibCompressFile: Boolean = True;
225     ZLibCompressFolder: Boolean = True;
226    
227     // (De)Coder 4.1 Standardeinstellungen
228     VTag: Byte = $02;
229     IDBase: LongInt = $84671842;
230     SeedSize: Byte = 32;
231     StMode: TCipherMode = cmCTSx;
232     StCipher: String = 'TCipher_Rijndael';
233     StHash: String = 'THash_SHA512';
234    
235     // (De)Coder 4.0 Kompatibilitätseinstellungen
236     DC40VTag: Byte = $01;
237     DC40IDBase: LongInt = $59178954;
238     DC40SeedSize: Byte = 16;
239     DC40StMode: TCipherMode = cmCTSx;
240     DC40StCipher: String = 'TCipher_Rijndael';
241     DC40StHash: String = 'THash_SHA512';
242    
243     // Konstanten von DEC
244     cyprefix: String = 'TCipher_';
245     haprefix: String = 'THash_';
246     CipherModeStr: array[0..8] of string = ('CTSx', 'CBCx', 'CFB8', 'CFBx', 'OFB8', 'OFBx', 'CFS8', 'CFSx', 'ECBx');
247    
248     { Eine zweite Instanz hat uns ihre Kommandozeilenparameter geschickt }
249     // von OneInst
250     procedure TMainForm.WMCopyData(var Msg: TWMCopyData);
251     var
252     i: integer;
253     temp: string;
254     tpara: string;
255     begin
256     if (Msg.CopyDataStruct.dwData = SecondInstMsgId) and (SecondInstMsgId <> 0) then
257     begin
258     if (steuerelementegesperrt or wartenform.Visible or
259     (not mainform.Visible)) and (paramstr_firstposition('/c') <> -1) and
260     (paramstr_firstposition('/x') <> -1) and (paramstr_firstposition('/e') <> -1) and
261     (paramstr_firstposition('/?') <> -1) and (paramstr_firstposition('/clean') <> -1) then
262     begin
263     temp := ParamBlobToStr(Msg.CopyDataStruct.lpData);
264     tpara := '';
265     for i := 0 to ZaehleLinien(temp)-1 do
266     tpara := tpara + '"'+GebeLinieaus(temp, i+1) + '" ';
267    
268     shellexecute(application.Handle, 'open', pchar(application.exename), pchar(tpara+'/newinstance'), pchar(extractfiledir(application.exename)), sw_normal);
269     end
270     else
271     ProcessCommandline(Msg.CopyDataStruct.lpData);
272     end
273     else
274     { Tcha wohl doch nicht ID - stimmte nicht }
275     inherited;
276     end;
277    
278     {----------------------------------------------------------------------------}
279     { Wir überschreiben den DefaultHandler, der alle Nachrichten zuerst bekommt, }
280     { damit wir auf die Nachricht mit der ID SecondInstMsgId reagieren können. }
281     { (Dies ist notwendig, da wir jetzt noch nicht wissen welchen Wert }
282     { die ID haben wird, weswegen wir keine statische Message-Prozedure, }
283     { so wie bei WM_COPYDATA, schreiben können.) }
284     {----------------------------------------------------------------------------}
285     // von OneInst
286     procedure TMainForm.DefaultHandler(var Message);
287     begin
288     if TMessage(Message).Msg = SecondInstMsgId then
289     { Eine zweite Instanz hat uns nach dem Handle gefragt }
290     { Es wird in die Message-Queue des Threads gepostet. }
291     PostThreadMessage(TMessage(Message).WParam, SecondInstMsgId, Handle, 0)
292     else
293     { Ansonsten rufen wir die geerbte Methode auf }
294     inherited;
295     end;
296    
297     procedure Schlafen(nDelay: Cardinal);
298     var
299     nStart: Cardinal;
300     begin
301     nStart := GetTickCount;
302     while GetTickCount-nStart < nDelay do
303     begin
304     Application.ProcessMessages;
305     Sleep(0);
306     end;
307     end;
308    
309     procedure TMainForm.Compress(InputFileName, OutputFileName: string);
310     begin
311     try
312     CompressInputStream:=TFileStream.Create(InputFileName, fmOpenRead);
313     try
314     CompressOutputStream:=TFileStream.Create(OutputFileName, fmCreate);
315     try
316     CompressionStream:=TCompressionStream.Create(clMax, CompressOutputStream);
317     try
318     CompressionStream.CopyFrom(CompressInputStream, CompressInputStream.Size);
319     finally
320     CompressionStream.Free;
321     end;
322     finally
323     CompressOutputStream.Free;
324     end;
325     finally
326     CompressInputStream.Free;
327     end;
328     except
329     // z.B. bei Programmabbruch
330     end;
331     end;
332    
333     procedure TMainForm.m_web_dm_click(Sender: TObject);
334     begin
335     shellexecute(application.Handle, 'open', 'http://www.daniel-marschall.de/', '', '', sw_normal);
336     end;
337    
338     procedure TMainForm.m_web_project_click(Sender: TObject);
339     begin
340     shellexecute(application.Handle, 'open', 'http://www.viathinksoft.de/index.php?page=projektanzeige&seite=projekt-18', '', '', sw_normal);
341     end;
342    
343     procedure TMainForm.Decompress(InputFileName, OutputFileName: string);
344     var
345     Buf: array[0..4095] of Byte;
346     Count: Integer;
347     begin
348     try
349     CompressInputStream:=TFileStream.Create(InputFileName, fmOpenRead);
350     try
351     CompressOutputStream:=TFileStream.Create(OutputFileName, fmCreate);
352     try
353     DecompressionStream := TDecompressionStream.Create(CompressInputStream);
354     try
355     while true do
356     begin
357     Count := DecompressionStream.Read(Buf[0], SizeOf(Buf));
358     if Count = 0 then
359     break
360     else
361     CompressOutputStream.Write(Buf[0], Count);
362     end;
363     finally
364     DecompressionStream.Free;
365     end;
366     finally
367     CompressOutputStream.Free;
368     end;
369     finally
370     CompressInputStream.Free;
371     end;
372     except
373     // z.B. bei Programmabbruch
374     end;
375     end;
376    
377     function TMainForm.GetLangEntry(name: string): string;
378     var
379     i: integer;
380     begin
381     for i := 0 to high(LangArray) do
382     begin
383     if LangArray[i].name = name then
384     begin
385     result := LangArray[i].text;
386     break;
387     end;
388     end;
389     end;
390    
391     function IsCapsLockOn: boolean;
392     begin
393     Result := 0 <>
394     (GetKeyState(VK_CAPITAL) and $01);
395     end;
396    
397     procedure TMainForm.progress_position(pos: integer);
398     begin
399     wartenform.pbr_progress.Position := pos;
400     if ((wartenform.pbr_progress.Position <> wartenform.pbr_progress.Min) and (GebeLinieaus(ParamZeile, 2) <> '/silent')) and (not wartenform.visible) then
401     begin
402     wartenform.Visible := true;
403     // tmr_openwartenform.Enabled := true;
404     end;
405    
406     application.ProcessMessages;
407     end;
408    
409     procedure TMainForm.zeige_wartenform(dothis: boolean);
410     begin
411     if dothis then
412     begin
413     if (GebeLinieaus(ParamZeile, 2) <> '/silent') and (not wartenform.visible) then
414     begin
415     progress_text('', '');
416     wartenform.Visible := true;
417     // tmr_openwartenform.Enabled := true;
418     end;
419     end
420     else
421     begin
422     progress_text('', '');
423     wartenform.Visible := false;
424     // wartenform.tmr_closetimer.enabled := true;
425     end;
426     end;
427    
428     procedure TMainForm.progress_text(text, item: string);
429     begin
430     wartenform.lbl_info1.caption := text;
431     wartenform.lbl_info2.caption := item;
432     application.processmessages;
433     end;
434    
435     function FormatiereZahlToStr(inp: extended): string;
436     begin
437     result := FloatToStrF(inp, ffNumber, 14, 2);
438     end;
439    
440     function lang_getdirectoryname(): string;
441     var
442     myreg: tregistry;
443     begin
444     result := '';
445     myreg := TRegistry.Create;
446     try
447     myreg.RootKey := HKEY_CLASSES_ROOT;
448     if myreg.OpenKey('Directory', false) then
449     begin
450     result := myreg.ReadString('');
451     end;
452     finally
453     myreg.free;
454     end;
455     end;
456    
457     function kazip_numfiles(ka: tkazip): integer;
458     var
459     i, a: Integer;
460     begin
461     a := 0;
462     for i := 0 to ka.FileNames.count - 1 do
463     begin
464     if copy(ka.FileNames.Strings[i], length(ka.FileNames.Strings[i]), 1) <> '\' then
465     inc(a);
466     end;
467     result := a;
468     end;
469    
470     { function kazip_numfolders(ka: tkazip): integer;
471     var
472     i, a: Integer;
473     begin
474     a := 0;
475     for i := 0 to ka.FileNames.count - 1 do
476     begin
477     if copy(ka.FileNames.Strings[i], length(ka.FileNames.Strings[i]), 1) = '\' then
478     inc(a);
479     end;
480     result := a;
481     end; }
482    
483     function IntelligenteDateigroesse(ibytes: int64): string;
484     begin
485     if ibytes > power(1024, 5) then
486     result := FormatiereZahlToStr(ibytes / power(1024, 4))+' EB'
487     else if ibytes > power(1024, 4) then
488     result := FormatiereZahlToStr(ibytes / power(1024, 4))+' TB'
489     else if ibytes > power(1024, 3) then
490     result := FormatiereZahlToStr(ibytes / power(1024, 3))+' GB'
491     else if ibytes > power(1024, 2) then
492     result := FormatiereZahlToStr(ibytes / power(1024, 2))+' MB'
493     else if ibytes > power(1024, 1) then
494     result := FormatiereZahlToStr(ibytes / power(1024, 1))+' KB'
495     else
496     begin
497     if ibytes = 1 then
498     result := FormatiereZahlToStr(ibytes)+' Byte'
499     else
500     result := FormatiereZahlToStr(ibytes)+' Bytes';
501     end;
502     end;
503    
504     procedure dc_deletefile(Filename: string);
505     const
506     buf = 1024;
507     var
508     S: TStream;
509     size: int64;
510     abbruch: boolean;
511     lAttributes: integer;
512     begin
513     if fileexists(filename) then
514     begin
515     try
516     lAttributes := FileGetAttr(Filename);
517     if lAttributes and SysUtils.faReadOnly <> 0 then
518     begin
519     lAttributes := lAttributes - SysUtils.faReadOnly;
520     FileSetAttr(Filename, lAttributes);
521     end;
522     S := TFileStream.Create(Filename, fmOpenWrite or fmShareExclusive);
523     try
524     size := S.Size;
525     mainform.progress_position(wartenform.pbr_progress.min);
526     mainform.progress_text(mainform.GetLangEntry('deletefile'), filename);
527     abbruch := false;
528     while not abbruch do
529     begin
530     size := size - buf;
531     if size > 0 then
532     begin
533     ProtectStream(S, buf);
534     mainform.progress_position(floor((s.size-size) / s.Size * wartenform.pbr_progress.max));
535     end
536     else
537     begin
538     if size < 0 then
539     ProtectStream(S, s.size-s.Position); // wenn nicht size = 0
540    
541     mainform.progress_position(wartenform.pbr_progress.min);
542    
543     abbruch := true;
544     end;
545     end;
546     finally
547     S.Free;
548     end;
549     deletefile(pchar(filename));
550     except
551    
552     end;
553     end;
554     end;
555    
556     procedure dc_deletedir(const Directory: String);
557     var
558     SR: TSearchRec;
559     zus: string;
560     begin
561     if copy(Directory, length(Directory), 1) <> '\' then
562     zus := '\'
563     else
564     zus := '';
565    
566     if FindFirst(Directory + zus + '*.*', faAnyFile - faDirectory, SR) = 0 then
567     try
568     repeat
569     try
570     dc_deletefile(Directory + zus + SR.Name)
571     except
572     // z.B. durch Benutzung oder durch Schreibschutz verursacht
573     end;
574     until FindNext(SR) <> 0;
575     finally
576     SysUtils.FindClose(SR);
577     end;
578    
579     if FindFirst(Directory + zus + '*.*', faAnyFile, SR) = 0 then
580     try
581     repeat
582     if ((SR.attr and faDirectory) = faDirectory) and (SR.Name <> '.') and (SR.Name <> '..') then
583     dc_deletedir(Directory + zus + SR.Name + '\');
584     until FindNext(SR) <> 0;
585     finally
586     SysUtils.FindClose(SR);
587     end;
588    
589     removedirectory(pchar(Directory));
590     end;
591    
592     // http://www.swissdelphicenter.ch/torry/showcode.php?id=144
593     function GetTempDir: string;
594     var
595     Buffer: array[0..MAX_PATH] of Char;
596     begin
597     GetTempPath(SizeOf(Buffer) - 1, Buffer);
598     Result := StrPas(Buffer);
599     end;
600    
601     // http://www.delphipraxis.net/post50248.html
602     function PassphraseQuality(const Password: String): Extended;
603     // returns computed Quality in range 0.0 to 1.0
604     // source extracted from Delphi Encryption Compendium, DEC
605    
606     function Entropy(P: PByteArray; L: Integer): Extended;
607     var
608     Freq: Extended;
609     I: Integer;
610     Accu: array[Byte] of LongWord;
611     begin
612     Result := 0.0;
613     if L <= 0 then Exit;
614     FillChar(Accu, SizeOf(Accu), 0);
615     for I := 0 to L-1 do Inc(Accu[P[I]]);
616     for I := 0 to 255 do
617     if Accu[I] <> 0 then
618     begin
619     Freq := Accu[I] / L;
620     Result := Result - Freq * (Ln(Freq) / Ln(2));
621     end;
622     end;
623    
624     function Differency: Extended;
625     var
626     S: String;
627     L,I: Integer;
628     begin
629     Result := 0.0;
630     L := Length(Password);
631     if L <= 1 then Exit;
632     SetLength(S, L-1);
633     for I := 2 to L do
634     Byte(S[I-1]) := Byte(Password[I-1]) - Byte(Password[I]);
635     Result := Entropy(Pointer(S), Length(S));
636     end;
637    
638     function KeyDiff: Extended;
639     const
640     Table = '^1234567890ß´qwertzuiopü+asdfghjklöä#<yxcvbnm,.-°!"§$%&/()=?`QWERTZUIOPÜ*ASDFGHJKLÖÄ''>YXCVBNM;:_';
641     var
642     S: String;
643     L,I,J: Integer;
644     begin
645     Result := 0.0;
646     L := Length(Password);
647     if L <= 1 then Exit;
648     S := Password;
649     UniqueString(S);
650     for I := 1 to L do
651     begin
652     J := Pos(S[I], Table);
653     if J > 0 then S[I] := Char(J);
654     end;
655     for I := 2 to L do
656     Byte(S[I-1]) := Byte(S[I-1]) - Byte(S[I]);
657     Result := Entropy(Pointer(S), L-1);
658     end;
659    
660     const
661     GoodLength = 10.0; // good length of Passphrases
662     var
663     L: Extended;
664     begin
665     Result := Entropy(Pointer(Password), Length(Password));
666     if Result <> 0 then
667     begin
668     Result := Result * (Ln(Length(Password)) / Ln(GoodLength));
669     L := KeyDiff + Differency;
670     if L <> 0 then L := L / 64;
671     Result := Result * L;
672     if Result < 0 then Result := -Result;
673     if Result > 1 then Result := 1;
674     end;
675     end;
676    
677     ///////////////////////////////////////////////////////////////////
678     // Call back function used to set the initial browse directory.
679     ///////////////////////////////////////////////////////////////////
680     function BrowseForFolderCallBack(Wnd: HWND; uMsg: UINT;
681     lParam, lpData: LPARAM): Integer stdcall;
682     begin
683     if uMsg = BFFM_INITIALIZED then
684     SendMessage(Wnd,BFFM_SETSELECTION,1,Integer(@mainform.lg_StartFolder[1]));
685     result := 0;
686     end;
687    
688     ///////////////////////////////////////////////////////////////////
689     // This function allows the user to browse for a folder
690     //
691     // Arguments:-
692     // browseTitle : The title to display on the browse dialog.
693     // NewFolder : Allow to create a new folder
694     // initialFolder : Optional argument. Use to specify the folder
695     // initially selected when the dialog opens.
696     //
697     // Returns: The empty string if no folder was selected (i.e. if the
698     // user clicked cancel), otherwise the full folder path.
699     ///////////////////////////////////////////////////////////////////
700     function BrowseForFolder(const browseTitle: String; const NewFolder: boolean = false;
701     const initialFolder: String =''): String;
702     var
703     browse_info: TBrowseInfo;
704     folder: array[0..MAX_PATH] of char;
705     find_context: PItemIDList;
706     const
707     BIF_NEWDIALOGSTYLE=$40;
708     begin
709     FillChar(browse_info,SizeOf(browse_info),#0);
710     mainform.lg_StartFolder := initialFolder;
711     browse_info.pszDisplayName := @folder[0];
712     browse_info.lpszTitle := PChar(browseTitle);
713     if NewFolder then
714     browse_info.ulFlags := BIF_RETURNONLYFSDIRS or BIF_NEWDIALOGSTYLE
715     else
716     browse_info.ulFlags := BIF_RETURNONLYFSDIRS;
717     browse_info.hwndOwner := Application.Handle;
718     if initialFolder <> '' then
719     browse_info.lpfn := BrowseForFolderCallBack;
720     find_context := SHBrowseForFolder(browse_info);
721     if Assigned(find_context) then
722     begin
723     if SHGetPathFromIDList(find_context,folder) then
724     result := folder
725     else
726     result := '';
727     GlobalFreePtr(find_context);
728     end
729     else
730     result := '';
731     end;
732    
733     // Entnommen von FileCtrl
734     procedure CutFirstDirectory(var S: TFileName);
735     var
736     Root: Boolean;
737     P: Integer;
738     begin
739     if S = '\' then
740     S := ''
741     else
742     begin
743     if S[1] = '\' then
744     begin
745     Root := True;
746     Delete(S, 1, 1);
747     end
748     else
749     Root := False;
750     if S[1] = '.' then
751     Delete(S, 1, 4);
752     P := AnsiPos('\',S);
753     if P <> 0 then
754     begin
755     Delete(S, 1, P);
756     S := '...\' + S;
757     end
758     else
759     S := '';
760     if Root then
761     S := '\' + S;
762     end;
763     end;
764    
765     // Entnommen von http://www.delphipraxis.net/post429178.html
766     function IsFileName(FileName: String): Boolean;
767     const ForbiddenChars = ['"', '<', '>', '|', '*', '/', '\', '?']; // verbotene Zeichen
768    
769     const ForbiddenNames: Array[0..22] of String[6] = ('AUX', 'NUL', 'PRN' ,'CON', 'CLOCK$', // verbotene Namen
770     'COM1', 'COM2', 'COM3', 'COM4', 'COM5', 'COM6', 'COM7', 'COM8', 'COM9',
771     'LPT1', 'LPT2', 'LPT3', 'LPT4', 'LPT5', 'LPT6', 'LPT7', 'LPT8', 'LPT9');
772    
773     var i: Integer;
774     var p: PChar;
775     var FileNameU: String;
776     begin
777     Result := False;
778    
779     if FileName <> '' then // Name darf nicht leer sein
780     begin
781     i := Length(FileName);
782    
783     if FileName[i] <> '.' then // letze Zeichen darf kein Punkt sein
784     begin
785     p := Pointer(FileName);
786    
787     repeat if p^ in ForbiddenChars then
788     Exit;
789     inc(p);
790     until p^ = #0;
791    
792     if (i < 7) and (i > 2) then
793     begin
794     FileNameU := UpperCase(FileName);
795     for i := 0 to High(ForbiddenNames) do
796     begin
797     if CompareStr(ForbiddenNames[i], FileNameU) = 0 then
798     Exit;
799     end;
800     end;
801    
802     Result := True;
803     end;
804     end;
805     end;
806    
807     // Original von Codebeispiel von Hagen Reddmann
808     procedure EncodeFile(const AFileName, AOutput: String; const APassword: Binary);
809    
810     procedure Write(const Value; Size: Integer);
811     begin
812     mainform.tempstream.WriteBuffer(Value, Size);
813     end;
814    
815     procedure WriteByte(Value: Byte);
816     begin
817     Write(Value, SizeOf(Value));
818     end;
819    
820     procedure WriteLong(Value: LongWord);
821     begin
822     Value := SwapLong(Value);
823     Write(Value, SizeOf(Value));
824     end;
825    
826     procedure WriteBinary(const Value: Binary);
827     begin
828     WriteByte(Length(Value));
829     Write(Value[1], Length(Value));
830     end;
831    
832     procedure WriteRaw(const Value: Binary);
833     begin
834     Write(Value[1], Length(Value));
835     end;
836    
837     var
838     Source: TStream;
839     Seed: Binary;
840     P: IDECProgress;
841     ACipher: TDECCipherClass;
842     AHash: TDECHashClass;
843     ACFileName: String;
844     begin
845     mainform.progress_position(wartenform.pbr_progress.min);
846     mainform.progress_text(mainform.GetLangEntry('encodedata'), afilename);
847    
848     ACipher := CipherByName(StCipher);
849     AHash := HashByName(StHash);
850    
851     ACipher := ValidCipher(ACipher);
852     AHash := ValidHash(AHash);
853    
854     Seed := RandomBinary(SeedSize);
855    
856     ACFileName := GetTempDir+TempPre+mainform.temp_unique_number+TempExtCmp;
857    
858     // Ordner (-> ZIP-Dateien) werden nicht nocheinmal komprimiert ... oder doch?
859     // if (ZLibCompressFile and (mainform.ersatzname = '')) or (ZLibCompressFolder and (mainform.ersatzname <> '')) then
860     if mainform.chk_compress.checked then
861     mainform.Compress(AFileName, ACFileName)
862     else
863     ACFileName := AFileName;
864    
865     Source := TFileStream.Create(ACFileName, fmOpenRead or fmShareDenyNone);
866     try
867     try
868     mainform.tempstream := TFileStream.Create(AOutput, fmOpenReadWrite or fmCreate);
869     try
870     with ACipher.Create do
871     try
872     try
873     Mode := TCipherMode(StMode);
874    
875     Init(AHash.KDFx(APassword, Seed, Context.KeySize));
876    
877     if mainform.ersatzname <> '' then
878     begin
879     if mainform.chk_compress.Checked then
880     writebyte(OrdnerCompressTag)
881     else
882     writebyte(OrdnerTag);
883     end
884     else
885     begin
886     if mainform.chk_compress.Checked then
887     writebyte(DateiCompressTag)
888     else
889     writebyte(DateiTag);
890     end;
891    
892     WriteByte(VTag);
893     {if mainform.ersatzname <> '' then
894     WriteRaw(Base64Encode(ExtractFileName(mainform.ersatzname)))
895     else
896     WriteRaw(Base64Encode(ExtractFileName(AFileName)));}
897     WriteRaw(Base64Encode(mainform.edt_vle1.text));
898     WriteRaw(FileNameTerminus);
899     WriteLong(IDBase);
900     WriteLong(acipher.Identity);
901     WriteByte(Byte(Mode));
902     WriteLong(ahash.Identity);
903     WriteByte(SeedSize);
904     WriteRaw(Seed);
905    
906     P := TProgress.Create;
907     try
908     EncodeStream(Source, mainform.tempstream, Source.Size, P);
909     except
910     // Kann auftreten, wenn das Programm beim Verschlüsseln geschlossen wird
911     exit;
912     end;
913     source.Position := 0;
914     WriteRaw(ahash.CalcBinary(ahash.CalcStream(source, source.size)+Seed+APassword));
915     WriteRaw(Base64Encode(Terminus));
916     finally
917     Free;
918     end;
919     except
920     raise;
921     end;
922     finally
923     try
924     mainform.tempstream.Free;
925     except
926     // kann passieren, wenn der Stream bereits durch FormClose geschlossen wurde
927     end;
928     end;
929     except
930     // Ist eine temporäre Datei und wird bei Programmbeendigung gelöscht
931     // dc_deletefile(aoutput);
932     mainform.steuerelementesperren(false);
933     raise; // programmablauf endet hier
934     end;
935     finally
936     Source.Free;
937     end;
938     end;
939    
940     // Original von Codebeispiel von Hagen Reddmann
941     procedure DecodeFile(const AFileName, AOutput: String; const APassword: Binary);
942     var
943     Source: TStream;
944     OrigName: string;
945     ahash: TDECHashClass;
946    
947     procedure Read(var Value; Size: Integer);
948     begin
949     Source.ReadBuffer(Value, Size);
950     end;
951    
952     function ReadByte: Byte;
953     begin
954     Read(Result, SizeOf(Result));
955     end;
956    
957     function ReadLong: LongWord;
958     begin
959     Read(Result, SizeOf(Result));
960     Result := SwapLong(Result);
961     end;
962    
963     function ReadBinary: Binary;
964     begin
965     SetLength(Result, ReadByte);
966     Read(Result[1], Length(Result));
967     end;
968    
969     function ReadRaw(leng: integer): Binary;
970     begin
971     SetLength(Result, leng);
972     Read(Result[1], Length(Result));
973     end;
974    
975     var
976     ch: string;
977     {F, }V: Byte;
978     P: IDECProgress;
979     Cipher: TDECCipher;
980     Seed: String;
981     begin
982     mainform.progress_position(wartenform.pbr_progress.min);
983     mainform.progress_text(mainform.GetLangEntry('decodedata'), afilename);
984    
985     Source := TFileStream.Create(AFileName, fmOpenRead or fmShareDenyNone);
986     try
987     try
988     {F := }ReadByte;
989     V := ReadByte;
990    
991     OrigName := '';
992     ch := readraw(1);
993     while ch <> FileNameTerminus do
994     begin
995     OrigName := OrigName + ch;
996     ch := readraw(1);
997     end;
998    
999     if V = VTag then
1000     begin
1001     OrigName := Base64Decode(OrigName);
1002     ReadLong; // IdendityBase wird bereits bei FileOpen gesetzt
1003     end;
1004    
1005     mainform.tempstream := TFileStream.Create(AOutput, fmOpenReadWrite or fmCreate);
1006     try
1007     try
1008     Cipher := nil;
1009     if V = DC40VTag then Cipher := ValidCipher(CipherByName(DC40StCipher)).Create;
1010     if V = VTag then Cipher := ValidCipher(CipherByIdentity(ReadLong)).Create;
1011     try
1012     AHash := nil;
1013     if V = DC40VTag then
1014     begin
1015     Cipher.Mode := TCipherMode(DC40StMode);
1016     AHash := HashByName(DC40StHash);
1017     end;
1018     if V = VTag then
1019     begin
1020     Cipher.Mode := TCipherMode(ReadByte);
1021     AHash := HashByIdentity(ReadLong);
1022     end;
1023     AHash := ValidHash(AHash);
1024    
1025     if V = DC40VTag then
1026     Seed := ReadRaw(DC40SeedSize);
1027     if V = VTag then
1028     Seed := ReadRaw(ReadByte);
1029    
1030     Cipher.Init(ahash.KDFx(APassword, Seed, Cipher.Context.KeySize));
1031    
1032     P := TProgress.Create;
1033     try
1034     if V = DC40VTag then
1035     Cipher.DecodeStream(Source, mainform.tempstream, source.size-source.Position-ahash.DigestSize, P);
1036     if V = VTag then
1037     Cipher.DecodeStream(Source, mainform.tempstream, source.size-source.Position-ahash.DigestSize-Length(Base64Encode(Terminus)), P);
1038     except
1039     // Kann auftreten, wenn das Programm beim Verschlüsseln geschlossen wird
1040     exit;
1041     end;
1042     mainform.tempstream.position := 0;
1043     if V = DC40VTag then
1044     begin
1045     if readraw(ahash.DigestSize) <> ahash.CalcStream(mainform.tempstream, mainform.tempstream.size) then
1046     raise EDECException.Create(mainform.GetLangEntry('hasherror'));
1047     end;
1048     if V = VTag then
1049     begin
1050     if readraw(ahash.DigestSize) <> ahash.CalcBinary(ahash.CalcStream(mainform.tempstream, mainform.tempstream.size)+Seed+APassword) then
1051     raise EDECException.Create(mainform.GetLangEntry('hasherror'));
1052     end;
1053     finally
1054     Cipher.Free;
1055     end;
1056     except
1057     // ProtectStream wird in dc_deletefile durchgeführt
1058     // ProtectStream(Dest);
1059     raise;
1060     end;
1061     finally
1062     try
1063     mainform.tempstream.Free;
1064     except
1065     // kann passieren, wenn der Stream bereits durch FormClose geschlossen wurde
1066     end;
1067     end;
1068     except
1069     // Ist eine temporäre Datei und wird bei Programmbeendigung gelöscht
1070     // dc_deletefile(aoutput);
1071     mainform.steuerelementesperren(false);
1072     raise; // programmablauf endet hier
1073     end;
1074     finally
1075     Source.Free;
1076     end;
1077     end;
1078    
1079     function FindeDateityp(filename: string): string;
1080     var
1081     Reg: TRegistry;
1082     temp: string;
1083     begin
1084     {* Dateityp herausfinden *}
1085     if ExtractFileExt(filename) <> '' then
1086     begin
1087     Reg := TRegistry.Create;
1088     try
1089     Reg.RootKey := HKEY_CLASSES_ROOT;
1090     if Reg.OpenKey(ExtractFileExt(filename), false) then
1091     begin
1092     temp := Reg.ReadString('');
1093     Reg.CloseKey();
1094     if temp <> '' then
1095     begin
1096     Reg.OpenKey(temp, false);
1097     temp := Reg.ReadString('');
1098     Reg.CloseKey();
1099     if temp <> '' then
1100     result := temp
1101     else
1102     result := ''; {* Weiterleitung hat keinen Namen für den Dateityp *}
1103     end
1104     else
1105     result := ''; {* Konnte keine Weiterleitung in der Registry finden *}
1106     end
1107     else
1108     result := ''; {* Keinen Eintrag der Erweiterung in der Registry gefunden *}
1109     finally
1110     Reg.free;
1111     end;
1112     end
1113     else
1114     result := ''; {* Keine Erweiterung *}
1115     end;
1116    
1117     { function SecureDeleteWhenUnlocked(Filename: string): boolean;
1118     var
1119     exc: boolean;
1120     chk: TStream;
1121     versuche: integer;
1122     begin
1123     result := true;
1124     if fileexists(Filename) then
1125     begin
1126     // Wenn die Datei nicht innerhalb von 5 Sekunden freigegeben, es einfach lassen
1127     versuche := 0;
1128     while versuche <= 500 do
1129     begin
1130     inc(versuche);
1131     try
1132     exc := false;
1133     // DE: shutdownwait=Warte, bis temporäre Dateien freigegeben sind.
1134     // EN: shutdownwait=Wait, till temporary files are unlocked...
1135     // mainform.progress_text(mainform.GetLangEntry('shutdownwait'));
1136     // mainform.progress_position(progress_min);
1137     application.ProcessMessages;
1138     chk := TFileStream.Create(Filename, fmOpenWrite or fmShareExclusive);
1139     Schlafen(10);
1140     chk.free;
1141     except
1142     exc := true; // immer noch gesperrt
1143     end;
1144     if not exc then break; // datei ist wieder schreibbar und somit löschbar
1145     end;
1146     dc_deletefile(Filename);
1147     if fileexists(Filename) then result := false; // Fehlgeschlagen
1148     end;
1149     end; }
1150    
1151     // http://www.swissdelphicenter.ch/torry/showcode.php?id=2413
1152     function DirectoryIsEmpty(Directory: string): Boolean;
1153     var
1154     SR: TSearchRec;
1155     i: Integer;
1156     begin
1157     Result := False;
1158     FindFirst(IncludeTrailingPathDelimiter(Directory) + '*', faAnyFile, SR);
1159     for i := 1 to 2 do
1160     if (SR.Name = '.') or (SR.Name = '..') then
1161     Result := FindNext(SR) <> 0;
1162     FindClose(SR);
1163     end;
1164    
1165     procedure DeleteTempFiles();
1166     var
1167     searchResult: TSearchRec;
1168     allesok, nichtsda: boolean;
1169     uqnr: string;
1170     begin
1171     mainform.zeige_wartenform(true);
1172     mainform.steuerelementesperren(true);
1173     try
1174    
1175     allesok := true;
1176     nichtsda := true;
1177    
1178     if (copy(lowercase(GebeLinieaus(ParamZeile, 2)), 0, 6) = '/only=') or (copy(lowercase(gebelinieaus(ParamZeile, 3)), 0, 6) = '/only=') then
1179     begin
1180     // Nur Sitzungsdaten von einer Sitzung löscchen
1181    
1182     if copy(lowercase(GebeLinieaus(ParamZeile, 2)), 0, 6) = '/only=' then
1183     uqnr := copy(GebeLinieaus(ParamZeile, 2), 7, length(GebeLinieaus(ParamZeile, 2))-6);
1184     if copy(lowercase(GebeLinieaus(ParamZeile, 3)), 0, 6) = '/only=' then
1185     uqnr := copy(GebeLinieaus(ParamZeile, 3), 7, length(GebeLinieaus(ParamZeile, 3))-6);
1186    
1187     if FindFirst(GetTempDir+'*.*', faAnyFile, searchResult) = 0 then
1188     begin
1189     repeat
1190     if (lowercase(copy(extractfilename(searchResult.Name), 0, length(extractfilename(searchResult.Name))-length(extractfileext(searchResult.Name)))) = lowercase(TempPre+uqnr)) and fileexists(GetTempDir+searchResult.Name) then
1191     begin
1192     nichtsda := false;
1193     dc_deletefile(GetTempDir+extractfilename(searchResult.Name));
1194     if fileexists(GetTempDir+extractfilename(searchResult.Name)) then
1195     allesok := false;
1196     end;
1197     until FindNext(searchResult) <> 0;
1198     FindClose(searchResult);
1199     end;
1200    
1201     if (directoryexists(GetTempDir+TempDirect+'\'+uqnr) and not DirectoryIsEmpty(GetTempDir+TempDirect+'\'+uqnr)) then
1202     begin
1203     nichtsda := false;
1204     dc_deletedir(GetTempDir+TempDirect+'\'+uqnr);
1205     if directoryexists(GetTempDir+TempDirect+'\'+uqnr) then
1206     allesok := false;
1207     end;
1208    
1209     end
1210     else
1211     begin
1212     // Alle Sitzungsdaten löschen
1213    
1214     if FindFirst(GetTempDir+'*.*', faAnyFile, searchResult) = 0 then
1215     begin
1216     repeat
1217     if (lowercase(copy(searchResult.Name, 0, length(TempPre))) = lowercase(TempPre)) and fileexists(GetTempDir+searchResult.Name) then
1218     begin
1219     nichtsda := false;
1220     dc_deletefile(GetTempDir+searchResult.Name);
1221     if fileexists(GetTempDir+searchResult.Name) then
1222     allesok := false;
1223     end;
1224     until FindNext(searchResult) <> 0;
1225     FindClose(searchResult);
1226     end;
1227    
1228     if directoryexists(GetTempDir+TempDirect) then
1229     begin
1230     nichtsda := false;
1231     dc_deletedir(GetTempDir+TempDirect);
1232     if directoryexists(GetTempDir+TempDirect) then
1233     allesok := false;
1234     end;
1235     end;
1236    
1237     if (lowercase(GebeLinieaus(ParamZeile, 2)) <> '/silent') then
1238     begin
1239     if nichtsda then
1240     Application.MessageBox(pchar(MainForm.GetLangEntry('nothingtoclean')), pchar(MainForm.GetLangEntry('information')), MB_OK + MB_ICONASTERISK)
1241     else
1242     begin
1243     if not allesok then
1244     Application.MessageBox(pchar(MainForm.GetLangEntry('cleaningerror')), pchar(MainForm.GetLangEntry('warning')), MB_OK + MB_ICONEXCLAMATION)
1245     else
1246     Application.MessageBox(pchar(MainForm.GetLangEntry('cleaningok')), pchar(MainForm.GetLangEntry('information')), MB_OK + MB_ICONASTERISK);
1247     end;
1248     end
1249     else
1250     begin
1251     if not allesok then
1252     MainForm.errorlevel := 8; // Datei oder Ordner konnte nicht oder nur teilweise entfernt werden.
1253     end;
1254    
1255     finally
1256     mainform.steuerelementesperren(false);
1257     mainform.zeige_wartenform(false);
1258     end;
1259     end;
1260    
1261     { function HexAnsicht(inp: string): string;
1262     var
1263     i: integer;
1264     begin
1265     result := '';
1266     for i := 1 to length(inp) do
1267     result := result + inttohex(ord(inp[i]), 2) + ' ';
1268     end; }
1269    
1270     procedure TMainForm.OpenFile(fil: string; alternativer_name: string = ''; dateiensammlung: boolean = false);
1271     var
1272     Source: TStream;
1273     O, T: string;
1274     F, V: byte;
1275     Dateigroesse: int64;
1276     ch: string;
1277     hash: TDECHashClass;
1278     cipher: TDECCipherClass;
1279     InfoSeedSize: byte;
1280     InfoMode: byte;
1281     FileInfo: SHFILEINFO;
1282    
1283     procedure Read(var Value; Size: Integer);
1284     begin
1285     Source.ReadBuffer(Value, Size);
1286     end;
1287    
1288     function ReadByte: Byte;
1289     begin
1290     Read(Result, SizeOf(Result));
1291     end;
1292    
1293     function ReadLong: LongWord;
1294     begin
1295     Read(Result, SizeOf(Result));
1296     Result := SwapLong(Result);
1297     end;
1298    
1299     function ReadBinary: Binary;
1300     begin
1301     SetLength(Result, ReadByte);
1302     Read(Result[1], Length(Result));
1303     end;
1304    
1305     function ReadRaw(leng: integer): Binary;
1306     begin
1307     SetLength(Result, leng);
1308     Read(Result[1], Length(Result));
1309     end;
1310    
1311     procedure Dateibeschaedigt();
1312     begin
1313     // ClientHeight := formanfangsgroesse;
1314     edt_vle3.Text := '-';
1315     edt_vle4.Text := '-';
1316     edt_vle5.Text := GetLangEntry('broken');
1317     edt_vle6.Text := '-';
1318     edt_vle7.Text := '-';
1319    
1320     lbl_passwort.Visible := false;
1321     lbl_passwort2.Visible := false;
1322     edt_passwort.Visible := false;
1323     edt_passwort2.Visible := false;
1324     lbl_entropy.Visible := false;
1325     lbl_equal.Visible := false;
1326     chk_securedelete.Visible := false;
1327     chk_compress.Visible := false;
1328     tmr_capslock.Enabled := false;
1329     lbl_capswarning.Visible := false;
1330     img_warning.Visible := false;
1331    
1332     b_decrypt.Visible := false;
1333     b_encrypt.Visible := false;
1334     b_direct.Visible := false;
1335     b_open.Visible := true;
1336     b_folder.Visible := true;
1337    
1338     if ausgabegesetzt <> '' then
1339     errorlevel := 1 // DC4 Datei beschädigt
1340     else
1341     begin
1342     // Application.MessageBox(pchar(GetLangEntry('errorreading')), pchar(GetLangEntry('error')), MB_OK + MB_ICONSTOP);
1343     img_error.visible := true;
1344     lbl_readerror.visible := true;
1345     end;
1346     end;
1347    
1348     begin
1349     steuerelementesperren(true);
1350     zeige_wartenform(true);
1351     try
1352    
1353     m_close.enabled := true;
1354     fileopen := fil;
1355    
1356     if (alternativer_name <> '') and (fileexists(alternativer_name) or directoryexists(alternativer_name)) then
1357     SHGetFileInfo(PChar(alternativer_name), 0, FileInfo, SizeOf(FileInfo), SHGFI_ICON or SHGFI_LARGEICON)
1358     else
1359     SHGetFileInfo(PChar(fil), 0, FileInfo, SizeOf(FileInfo), SHGFI_ICON or SHGFI_LARGEICON);
1360    
1361     img_type.Picture.Icon.Handle := FileInfo.hIcon;
1362    
1363     if alternativer_name <> '' then
1364     begin
1365     edt_vle1.Text := ExtractFileName(alternativer_name);
1366     if fileexists(alternativer_name) or directoryexists(alternativer_name) then
1367     edt_vle2.Text := ExtractFilePath(alternativer_name)
1368     else
1369     edt_vle2.Text := ExtractFilePath(fil);
1370     caption := '(De)Coder '+DC4Ver+' [' + extractfilename(alternativer_name) + ']';
1371     end
1372     else
1373     begin
1374     edt_vle1.Text := ExtractFileName(fil);
1375     edt_vle2.Text := ExtractFilePath(fil);
1376     caption := '(De)Coder '+DC4Ver+' [' + extractfilename(fil) + ']';
1377     end;
1378    
1379     edt_vle3.Text := '';
1380     edt_vle4.Text := '';
1381     edt_vle5.Text := '';
1382     edt_vle6.Text := '';
1383     edt_vle7.Text := '';
1384    
1385     edt_passwort.Text := '';
1386     edt_passwort2.Text := '';
1387     edt_passwort_change(edt_passwort);
1388     chk_securedelete.Checked := paramzeile_firstposition('/x') <> -1;
1389     chk_compress.Checked := true;
1390     // wird durch edt_enc_password_change automatisch aufgerufen
1391     // edt_enc_password2_change(edt_enc_password2);
1392    
1393     dlg_save_dec.filter := GetLangEntry('filter_all')+' (*.*)|*.*';
1394     dlg_save_dec.filename := '';
1395     dlg_save_dec.defaultext := '';
1396     dlg_save_enc.filename := '';
1397    
1398     mode := tcUnknown;
1399    
1400     Source := TFileStream.Create(fil, fmOpenRead or fmShareDenyNone);
1401    
1402     try
1403     try
1404     if lowercase(extractfileext(fil)) = lowercase(ExtDC4) then
1405     begin
1406     edt_vle1.Color := clBtnFace;
1407     edt_vle1.ReadOnly := true;
1408     edt_vle1.TabStop := false;
1409    
1410     F := ReadByte; // ID-Flag (Datei/Ordner)
1411     V := ReadByte; // Versions-Flag
1412    
1413     if V = DC40VTag then edt_vle5.Text := Format(GetLangEntry('encrypted'), ['(De)Coder 4.0']);
1414     if V = VTag then edt_vle5.Text := Format(GetLangEntry('encrypted'), ['(De)Coder 4.1']);
1415    
1416     if ((F <> DateiTag) and (F <> DateiCompressTag) and (F <> OrdnerTag) and (F <> OrdnerCompressTag)) or ((V <> DC40VTag) and (V <> VTag)) then
1417     begin
1418     Dateibeschaedigt;
1419     steuerelementesperren(false);
1420     exit;
1421     end;
1422    
1423     cipher := nil;
1424     hash := nil;
1425    
1426     if V = DC40VTag then
1427     begin
1428     cipher := CipherByName(DC40StCipher);
1429     hash := HashByName(DC40StHash);
1430     end;
1431    
1432     if V = VTag then
1433     begin
1434     cipher := CipherByName(StCipher);
1435     hash := HashByName(StHash);
1436     end;
1437    
1438     cipher := validcipher(cipher);
1439     hash := validhash(hash);
1440    
1441     // damit später bei DecodeFile entschieden werden kann, ob entzippt werden muss
1442     flag := F;
1443    
1444     O := '';
1445     ch := readraw(1);
1446     while ch <> FileNameTerminus do
1447     begin
1448     O := O + ch;
1449     ch := readraw(1);
1450     end;
1451     if V = VTag then O := Base64Decode(O);
1452    
1453     // Idendity Base
1454     if (V = VTag) then
1455     IdentityBase := ReadLong
1456     else
1457     IdentityBase := DC40IDBase;
1458    
1459     InfoSeedSize := DC40SeedSize;
1460     InfoMode := Byte(DC40StMode);
1461     if (V = VTag) then
1462     begin
1463     cipher := CipherByIdentity(ReadLong);
1464     InfoMode := ReadByte;
1465     hash := HashByIdentity(ReadLong);
1466    
1467     cipher := ValidCipher(cipher);
1468     hash := ValidHash(hash);
1469    
1470     InfoSeedSize := ReadByte;
1471     end;
1472    
1473     if IsFileName(O) then
1474     begin
1475     dlg_save_dec.FileName := O;
1476     dlg_save_dec.DefaultExt := copy(extractfileext(O), 1, length(extractfileext(O)));
1477     end
1478     else
1479     begin
1480     dateibeschaedigt;
1481     steuerelementesperren(false);
1482     exit;
1483     end;
1484    
1485     edt_vle6.Text := O;
1486    
1487     if (F = OrdnerTag) or (F = OrdnerCompressTag) then
1488     begin
1489     T := lang_getdirectoryname;
1490     ersatzname := O; // damit nach decodefile der richtige ordnername verwendet wird
1491     end;
1492     if (F = DateiTag) or (F = DateiCompressTag) then
1493     begin
1494     T := FindeDateityp(O);
1495     ersatzname := '';
1496     end;
1497    
1498     if (T = '') then T := Format(GetLangEntry('x-file'), [uppercase(copy(extractfileext(O), 2, length(extractfileext(O))-1))]);
1499     edt_vle3.Text := T;
1500    
1501     dlg_save_dec.Filter := T+' (*'+lowercase(extractfileext(O))+')|*'+lowercase(extractfileext(O))+'|'+GetLangEntry('filter_all')+' (*.*)|*.*';
1502    
1503     Dateigroesse := source.size - hash.DigestSize - source.Position - InfoSeedSize;
1504     If V = VTag then Dateigroesse := Dateigroesse - length(Base64Encode(Terminus));
1505    
1506     if Dateigroesse < 0 then
1507     begin
1508     dateibeschaedigt;
1509     steuerelementesperren(false);
1510     exit;
1511     end
1512     else
1513     begin
1514     if (F = DateiCompressTag) or (F = OrdnerTag) or (F = OrdnerCompressTag) then edt_vle4.Text := GetLangEntry('compressed')+': ';
1515     edt_vle4.Text := edt_vle4.Text + IntelligenteDateigroesse(Dateigroesse);
1516     end;
1517    
1518     if V = VTag then
1519     begin
1520     source.Position := source.Size - length(Base64Encode(terminus));
1521     if ReadRaw(length(Base64Encode(terminus))) <> Base64Encode(terminus) then
1522     begin
1523     dateibeschaedigt;
1524     steuerelementesperren(false);
1525     exit;
1526     end;
1527     end;
1528    
1529     edt_vle7.Text := copy(cipher.ClassName, length(cyprefix)+1, length(cipher.ClassName)-length(cyprefix)) +
1530     ' ('+CipherModeStr[InfoMode]+'), ' +
1531     copy(hash.ClassName, length(haprefix)+1, length(hash.ClassName)-length(haprefix)) +
1532     ' (' + Format(GetLangEntry('x-byte-seed'), [InfoSeedSize]) + ')';
1533    
1534     // source.Position := source.size - cipher.context.BufferSize - hash.DigestSize;
1535     // l_calcmac, HexAnsicht(readraw(cipher.context.BufferSize)
1536     // l_filehash, HexAnsicht(readraw(hash.DigestSize)
1537    
1538     b_decrypt.Visible := true;
1539     b_encrypt.Visible := false;
1540     b_direct.Visible := true;
1541     b_open.Visible := false;
1542     b_folder.Visible := false;
1543    
1544     chk_compress.Visible := false;
1545    
1546     mode := tcEncrypted;
1547     end
1548     else
1549     begin
1550     edt_vle1.Color := clWindow;
1551     edt_vle1.ReadOnly := false;
1552     edt_vle1.TabStop := true;
1553    
1554     IdentityBase := IDBase;
1555    
1556     // damit später in EncodeFile nicht der Name der DeCoder.zip geschrieben wird, sondern der Verzeichnisname
1557     ersatzname := alternativer_name;
1558    
1559     edt_vle5.Text := GetLangEntry('unencrypted');
1560    
1561     edt_vle6.Text := '-';
1562    
1563     if alternativer_name <> '' then
1564     begin
1565     if alternativer_name = getlangentry('dateiensammlung') then
1566     T := getlangentry('dateiensammlung')
1567     else
1568     T := lang_getdirectoryname;
1569     end
1570     else
1571     begin
1572     T := FindeDateityp(fil);
1573     if (T = '') then T := Format(GetLangEntry('x-file'), [uppercase(copy(extractfileext(fil), 2, length(extractfileext(fil))-1))]);
1574     end;
1575     edt_vle3.Text := T;
1576    
1577     edt_vle4.Text := IntelligenteDateigroesse(source.size);
1578    
1579     edt_vle7.Text := '-';
1580    
1581     b_decrypt.Visible := false;
1582     b_encrypt.Visible := true;
1583     b_direct.Visible := false;
1584     b_open.Visible := false;
1585     b_folder.Visible := false;
1586    
1587     chk_compress.Visible := true;
1588     if alternativer_name = '' then
1589     chk_compress.Checked := ZLibCompressFile
1590     else
1591     chk_compress.Checked := ZLibCompressFolder;
1592    
1593     mode := tcDecrypted;
1594     end;
1595    
1596     finally
1597     source.free;
1598     end;
1599     except
1600     dateibeschaedigt;
1601     steuerelementesperren(false);
1602     exit;
1603     end;
1604    
1605     finally
1606     steuerelementesperren(false);
1607     zeige_wartenform(false);
1608     end;
1609    
1610     lbl_passwort.Visible := true;
1611     lbl_passwort2.Visible := mode <> tcEncrypted;
1612     edt_passwort.Visible := true;
1613     edt_passwort2.Visible := mode <> tcEncrypted;
1614     lbl_entropy.Visible := mode <> tcEncrypted;
1615     lbl_equal.Visible := mode <> tcEncrypted;
1616     chk_securedelete.Visible := true;
1617     lbl_readerror.Visible := false;
1618     img_error.Visible := false;
1619     tmr_capslock.Enabled := true;
1620    
1621     if ((mode = tcDecrypted) or (mode = tcEncrypted)) and (edt_passwort.Showing) then edt_passwort.SetFocus;
1622     mm_actions.visible := mode <> tcUnknown;
1623     m_encrypt.Enabled := mode = tcDecrypted;
1624     m_decrypt.Enabled := mode = tcEncrypted;
1625     m_direct.Enabled := mode = tcEncrypted;
1626    
1627     if (alternativer_name = getlangentry('dateiensammlung')) and (mode = tcDecrypted) then
1628     begin
1629     m_dateiensammlung_add_file.Enabled := true;
1630     m_dateiensammlung_add_folder.Enabled := true;
1631     m_dateiensammlung_show.Enabled := true;
1632     end
1633     else
1634     begin
1635     m_dateiensammlung_add_file.Enabled := false;
1636     m_dateiensammlung_add_folder.Enabled := false;
1637     m_dateiensammlung_show.Enabled := false;
1638     end;
1639    
1640     application.Restore;
1641     application.BringToFront;
1642    
1643     tmr_refresh.Enabled := true;
1644     end;
1645    
1646     procedure TMainForm.kazip_onchange(Sender: TObject; ChangeType: Integer);
1647     begin
1648     //
1649     end;
1650    
1651     procedure TMainForm.kazip_overwrite(Sender:TObject; Var FileName : String; Var Action : TOverwriteAction);
1652     begin
1653     //
1654     end;
1655    
1656     procedure TMainForm.form_create(Sender: TObject);
1657     var
1658     ini: TIniFile;
1659     str: TStringList;
1660     i: integer;
1661     begin
1662     ClientHeight := 297; // Bug in Delphi verändert manchmal Formhöhe
1663    
1664     errorlevel := 0; // Keine Fehler
1665    
1666     // Sprachdatei einlesen
1667     if fileexists(ExtractFilePath(Application.ExeName)+'Language.ini') then
1668     begin
1669     ini := TIniFile.Create(ExtractFilePath(Application.ExeName)+'Language.ini');
1670    
1671     // Version prüfen
1672     if (ini.ReadString('Signature', 'Version', '') <> DC4Ver) then
1673     begin
1674     // paramstr() wird verwendet, weil ParamZeile erst bei Start() gesetzt wird
1675     if not ((paramstr_firstposition('/clean') <> -1) and (paramstr_firstposition('/silent') <> -1)) then
1676     begin
1677     Application.MessageBox('Language.ini', 'Signature?', MB_OK + MB_ICONERROR);
1678     errorlevel := 11;
1679     close;
1680     exit;
1681     end;
1682     end;
1683    
1684     str := TStringList.Create();
1685     try
1686     ini.ReadSection(Name, str);
1687     for i := 0 to str.count-1 do
1688     begin
1689     setlength(LangArray, length(LangArray)+1);
1690     LangArray[length(LangArray)-1].name := str.strings[i];
1691     LangArray[length(LangArray)-1].text := ini.ReadString(name, str.strings[i], '?');
1692     LangArray[length(LangArray)-1].text := StringReplace(LangArray[length(LangArray)-1].text, '###', #13#10, [rfReplaceAll]);
1693     end;
1694     finally
1695     ini.free;
1696     str.Free;
1697     end;
1698     end
1699     else
1700     begin
1701     Application.MessageBox('Language.ini', 'Error', MB_OK + MB_ICONERROR);
1702     errorlevel := 11;
1703     close;
1704     exit;
1705     end;
1706    
1707     // Jetzt gehts los...
1708    
1709     // VCL-Ersatz
1710    
1711     DropFile := TDropFileTarget.Create(self);
1712     DropFile.Dragtypes := [dtCopy];
1713     DropFile.OnDrop := dropfile_drop;
1714    
1715     KaZip := TKaZip.Create(self);
1716     KaZip.UseTempFiles := false;
1717     kazip.CompressionType := StZIPType;
1718     KaZip.OverwriteAction := oaOverwriteAll;
1719     KaZip.OnDecompressFile := kazip_actions_decompress;
1720     KaZip.OnCompressFile := kazip_actions_compress;
1721     KaZip.OnZipChange := kazip_onchange;
1722     //KaZip.OnZipOpen := kazip_actions;
1723     KaZip.OnAddItem := kazip_add;
1724     //KaZip.OnRebuildZip := kazip_actions;
1725     //KaZip.OnRemoveItems := kazip_actions;
1726     KaZip.OnOverwriteFile := kazip_overwrite;
1727    
1728     {xpmenu := TXPMenu.Create(self);
1729     xpmenu.XPControls := [xcMainMenu];
1730     xpmenu.Gradient := true;
1731     xpmenu.Active := true;}
1732    
1733     // Anwendung vorbereiten
1734    
1735     RegisterDECClasses([TCipher_Blowfish, TCipher_Twofish, TCipher_IDEA,
1736     TCipher_Cast256, TCipher_Mars, TCipher_RC4, TCipher_RC6, TCipher_Rijndael,
1737     TCipher_Square, TCipher_SCOP, TCipher_Sapphire, TCipher_1DES, TCipher_2DES,
1738     TCipher_3DES, TCipher_2DDES, TCipher_3DDES, TCipher_3TDES, TCipher_3Way,
1739     TCipher_Cast128, TCipher_Gost, TCipher_Misty, TCipher_NewDES, TCipher_Q128,
1740     TCipher_RC2, TCipher_RC5, TCipher_SAFER, TCipher_Shark, TCipher_Skipjack,
1741     TCipher_TEA, TCipher_TEAN]);
1742    
1743     RegisterDECClasses([THash_MD2, THash_MD4, THash_MD5, THash_SHA, THash_SHA1,
1744     THash_SHA256, THash_SHA384, THash_SHA512, THash_Sapphire, THash_Panama,
1745     THash_Tiger, THash_RipeMD128, THash_RipeMD160, THash_RipeMD256,
1746     THash_RipeMD320, THash_Haval128, THash_Haval160, THash_Haval192,
1747     THash_Haval224, THash_Haval256, THash_Whirlpool, THash_Whirlpool1,
1748     THash_Square, THash_Snefru128, THash_Snefru256]);
1749    
1750     SetDefaultCipherClass(CipherByName(StCipher));
1751     SetDefaultHashClass(HashByName(StHash));
1752    
1753     RandomSeed;
1754    
1755     Randomize;
1756     temp_unique_number := inttostr(random(2147483647));
1757    
1758     // Formular vorbereiten
1759     img_warning.Picture.Bitmap.LoadFromResourceName(hInstance, 'WARNING');
1760     img_error.Picture.Bitmap.LoadFromResourceName(hInstance, 'ERROR');
1761     img_type.Picture.Bitmap.LoadFromResourceName(hInstance, 'NOOPEN');
1762    
1763     mm_file.Caption := GetLangEntry('file');
1764     m_open.Caption := GetLangEntry('openhint');
1765     m_folder.Caption := GetLangEntry('folderhint');
1766     m_config.Caption := GetLangEntry('confighint');
1767     m_close.Caption := GetLangEntry('closefile');
1768     m_exit.Caption := GetLangEntry('exit');
1769    
1770     mm_dateiensammlung.caption := GetLangEntry('dateiensammlung');
1771     m_dateiensammlung_neu.caption := GetLangEntry('dateiensammlung_neu');
1772     m_dateiensammlung_add_file.caption := GetLangEntry('dateiensammlung_add_file');
1773     m_dateiensammlung_add_folder.caption := GetLangEntry('dateiensammlung_add_folder');
1774     m_dateiensammlung_show.caption := GetLangEntry('dateiensammlung_show');
1775    
1776     mm_actions.Caption := GetLangEntry('actions');
1777     m_encrypt.Caption := GetLangEntry('enchint');
1778     m_decrypt.Caption := GetLangEntry('dechint');
1779     m_direct.Caption := GetLangEntry('direct');
1780     m_delete.Caption := GetLangEntry('erase');
1781    
1782     mm_help.Caption := GetLangEntry('help');
1783     m_help.Caption := GetLangEntry('helphint');
1784     m_web_update.Caption := GetLangEntry('updates');
1785     m_web_email.Caption := GetLangEntry('web_email');
1786     m_web_keytransmitter.Caption := GetLangEntry('web_keytransmitter');
1787     m_info.Caption := GetLangEntry('about');
1788     m_web.Caption := GetLangEntry('web_ressources');
1789     m_web_dm.Caption := GetLangEntry('web_dm');
1790     m_web_vts.Caption := GetLangEntry('web_vts');
1791     m_web_project.Caption := GetLangEntry('web_project');
1792     m_web_infopages.Caption := GetLangEntry('web_infopages');
1793     m_web_forum.Caption := GetLangEntry('web_forum');
1794    
1795     b_open.Caption := GetLangEntry('openhint');
1796     b_folder.Caption := GetLangEntry('folderhint');
1797     b_encrypt.Caption := GetLangEntry('enchint');
1798     b_decrypt.Caption := GetLangEntry('dechint');
1799     b_direct.Caption := GetLangEntry('direct');
1800    
1801     caption := '(De)Coder '+DC4Ver;
1802     lbl_vle1.Caption := GetLangEntry('opened');
1803     lbl_vle2.Caption := GetLangEntry('location');
1804     lbl_vle3.Caption := GetLangEntry('filetype');
1805     lbl_vle4.Caption := GetLangEntry('filesize');
1806     lbl_vle5.Caption := GetLangEntry('status');
1807     lbl_vle6.Caption := GetLangEntry('originalname');
1808     lbl_vle7.Caption := GetLangEntry('cryptmode');
1809     lbl_passwort.caption := GetLangEntry('password');
1810     lbl_passwort2.caption := GetLangEntry('repassword');
1811     lbl_equal.Hint := GetLangEntry('equalhint');
1812     lbl_equal.caption := '';
1813     lbl_entropy.Hint := GetLangEntry('entropy');
1814     chk_securedelete.Caption := GetLangEntry('securedelete');
1815     chk_compress.Caption := GetLangEntry('compress');
1816     img_warning.Hint := GetLangEntry('capswarning');
1817     lbl_capswarning.caption := GetLangEntry('capslock');
1818     lbl_capswarning.Hint := GetLangEntry('capswarning');
1819     dlg_open.filter := GetLangEntry('filter_all')+' (*.*)|*.*|'+GetLangEntry('filter_encrypted')+' (*.dc4)|*.dc4';
1820     dlg_open_element.filter := GetLangEntry('filter_all')+' (*.*)|*.*';
1821     dlg_save_dec.filter := GetLangEntry('filter_all')+' (*.*)|*.*';
1822     dlg_save_enc.filter := GetLangEntry('filter_encrypted')+' (*.dc4)|*.dc4';
1823     lbl_readerror.caption := GetLangEntry('errorreading');
1824     //progress_position(wartenform.ProgressBar1.min);
1825    
1826     edt_vle1.text := GetLangEntry('nofile');
1827     lbl_entropy.Caption := '';
1828    
1829     DropFile.Register(mainform);
1830    
1831     // Dynamische Größenanpassung der Elemente aufgrund verschiedener Sprachen
1832    
1833     edt_vle1.left := lbl_vle1.Left + 8 + max_7(lbl_vle1.Width, lbl_vle2.Width, lbl_vle3.Width, lbl_vle4.Width, lbl_vle5.Width, lbl_vle6.Width, lbl_vle7.Width);
1834     edt_vle2.left := edt_vle1.left;
1835     edt_vle3.left := edt_vle1.left;
1836     edt_vle4.left := edt_vle1.left;
1837     edt_vle5.left := edt_vle1.left;
1838     edt_vle6.left := edt_vle1.left;
1839     edt_vle7.left := edt_vle1.left;
1840    
1841     edt_vle1.Width := clientwidth - edt_vle1.Left - 8;
1842     edt_vle2.Width := edt_vle1.Width;
1843     edt_vle3.Width := edt_vle1.Width;
1844     edt_vle4.Width := edt_vle1.Width;
1845     edt_vle5.Width := edt_vle1.Width;
1846     edt_vle6.Width := edt_vle1.Width;
1847     edt_vle7.Width := edt_vle1.Width;
1848    
1849     edt_passwort.left := lbl_passwort.left + max_2(lbl_passwort.width, lbl_passwort2.width) + 8;
1850     edt_passwort2.left := edt_passwort.left;
1851     lbl_entropy.left := edt_passwort.left + edt_passwort.width + 8;
1852     lbl_equal.left := lbl_entropy.left;
1853     end;
1854    
1855     function FindeFreienOrdnernamen(verzeichnis: string): string;
1856     var
1857     i: integer;
1858     act: string;
1859     begin
1860     act := verzeichnis;
1861     i := 1;
1862     while directoryexists(act) or fileexists(act) do
1863     begin
1864     inc(i);
1865     act := verzeichnis+' ('+inttostr(i)+')';
1866     end;
1867     result := act;
1868     end;
1869    
1870     function NumberOfFiles(RootFolder: string): integer;
1871     var
1872     SR: TSearchRec;
1873     Num: integer;
1874     begin
1875     Num := 0;
1876     result := 0;
1877    
1878     if RootFolder = '' then
1879     Exit;
1880     if AnsiLastChar(RootFolder)^ <> '\' then
1881     RootFolder := RootFolder + '\';
1882    
1883     RootFolder := IncludeTrailingPathDelimiter(RootFolder);
1884    
1885     if FindFirst(RootFolder + '*.*', faAnyFile, SR) = 0 then
1886     try
1887     repeat
1888     if SR.Attr and faDirectory = faDirectory then
1889     // --> ein Verzeichnis wurde gefunden
1890     if (SR.Name <> '.') and (SR.Name <> '..') then
1891     Num := Num + NumberOfFiles(RootFolder + SR.Name);
1892     until FindNext(SR) <> 0;
1893     finally
1894     FindClose(SR);
1895     end;
1896     if FindFirst(RootFolder + '*.*', faAnyFile, SR) = 0 then
1897     try
1898     repeat
1899     if SR.Attr and faDirectory <> faDirectory then
1900     begin
1901     // --> eine Datei wurde gefunden
1902     inc(Num);
1903     end;
1904     until FindNext(SR) <> 0;
1905     finally
1906     FindClose(SR);
1907     end;
1908    
1909     result := Num;
1910     end;
1911    
1912     procedure TMainForm.openfolder(fol: string);
1913     var
1914     tz: string;
1915     begin
1916     steuerelementesperren(true);
1917     zeige_wartenform(true);
1918     try
1919    
1920     // Vorrausberechnung für ZIP-Vorgang
1921     DateienImOrdner := NumberOfFiles(fol);
1922     DateienCounter := 0;
1923    
1924     // Tempname
1925     tz := GetTempDir+TempPre+temp_unique_number+TempExtZip;
1926    
1927     dc_deletefile(tz);
1928     zipfolder(fol, tz);
1929    
1930     if fileexists(tz) then
1931     begin
1932     // Oha! Ein ganzes Laufwerk wurde verschlüsselt (da hat jemand zu viel Zeit...)
1933     if copy(fol, length(fol)-1, 2) = ':\' then
1934     fol := GetLangEntry('drive')+' '+copy(fol, 0, 1);
1935     openfile(tz, fol, false);
1936     end;
1937    
1938     finally
1939     steuerelementesperren(false);
1940     zeige_wartenform(false);
1941     end;
1942     end;
1943    
1944     procedure TMainForm.zipfolder(verzeichnis, zipname: string);
1945     begin
1946     try
1947     KAZip.Close;
1948     except
1949    
1950     end;
1951    
1952     progress_position(wartenform.pbr_progress.min);
1953     progress_text(GetLangEntry('zip_folder'), verzeichnis);
1954    
1955     try
1956     CreateZipFile(zipname);
1957    
1958     KAZip.Open(zipname);
1959     kazip.AddFolder(verzeichnis, verzeichnis, '*', true);
1960     kazip.close;
1961     except
1962     // Kann auftreten, wenn Anwendung beim Zippen geschlossen wurde
1963     end;
1964    
1965     progress_position(wartenform.pbr_progress.min);
1966     end;
1967    
1968     procedure TMainForm.freestreams();
1969     begin
1970     // ich kenne keine andere möglichkeit, den laufenden cipher-prozess zu beenden
1971     // ich gebe einfach den stream frei und fange die exceptions ab
1972    
1973     try
1974     kazip.Close;
1975     except
1976     end;
1977    
1978     try
1979     tempstream.Free;
1980     except
1981     end;
1982    
1983     try
1984     CompressInputStream.free;
1985     except
1986     end;
1987    
1988     try
1989     CompressOutputStream.free;
1990     except
1991     end;
1992    
1993     try
1994     CompressionStream.free;
1995     except
1996     end;
1997    
1998     try
1999     DeCompressionStream.Free;
2000     except
2001     end;
2002    
2003     try
2004     ZippingStream.Free;
2005     except
2006     end;
2007    
2008     try
2009     DropFile.unregister;
2010     except
2011     end;
2012    
2013     try
2014     DropFile.Free;
2015     except
2016     end;
2017    
2018     try
2019     KaZip.Free;
2020     except
2021     end;
2022    
2023     try
2024     BestimmeDateiGroesseSource.Free;
2025     except
2026     end;
2027    
2028     {try
2029     XPMenu.Free;
2030     except
2031     end;}
2032     end;
2033    
2034     procedure TMainForm.form_close(Sender: TObject; var Action: TCloseAction);
2035     begin
2036     steuerelementesperren(true);
2037     bordericons := [];
2038    
2039     // Weitermachen, bis die Dateien nicht mehr gesperrt ist
2040     // wird nun von eigenen Prozess übernommen
2041     // SecureDeleteWhenUnlocked(GetTempDir+TempPre+temp_unique_number+TempExtTmp);
2042     // SecureDeleteWhenUnlocked(GetTempDir+TempPre+temp_unique_number+TempExtZip);
2043    
2044     // Beim Beenden, sollen nur die temporären Dateien der aktuellen Sitzung entfernt werden,
2045     // daher macht diese Zeile wenig Sinn!
2046     // if paramzeile_firstposition('/clean') = -1 then
2047     // ShellExecute(application.Handle, 'open', pchar(application.exename), pchar('/clean /silent'), pchar(extractfilepath(application.exename)), SW_HIDE);
2048    
2049     // Information: Da 10 Sekunden bei /clean /silent gewartet wird, kann bereits hier gestartet werden
2050    
2051     if (paramzeile_firstposition('/clean') = -1) and (errorlevel <> 11) then
2052     ShellExecute(application.Handle, 'open', pchar(application.exename), pchar('/clean /silent /only='+temp_unique_number), pchar(extractfilepath(application.exename)), SW_HIDE);
2053    
2054     try
2055     freestreams;
2056     except
2057    
2058     end;
2059    
2060     halt(mainform.errorlevel);
2061    
2062     //application.Terminate; // Wenn über Befehlszeile verschlüsselt wird,
2063     // dann ist diese Zeile notwendig, ansonsten endet
2064     // die Anwendung nie
2065     end;
2066    
2067     function TMainForm.Unzip(ZipFile, Verzeichnis: string): boolean;
2068     begin
2069     result := true;
2070     steuerelementesperren(true);
2071     zeige_wartenform(true);
2072     try
2073     progress_position(wartenform.pbr_progress.min);
2074     progress_text(GetLangEntry('unzip_folder'), zipfile);
2075     kazip.Open(ZipFile);
2076     DateienImOrdner := kazip_numfiles(kazip);
2077     DateienCounter := 0;
2078     if (not kazip.IsZipFile) and (not kazip.HasBadEntries) then
2079     begin
2080     removedir(Verzeichnis);
2081     if ausgabegesetzt = '' then
2082     Application.MessageBox(pchar(GetLangEntry('archivecorrupt')), pchar(GetLangEntry('error')), MB_OK + MB_ICONSTOP);
2083     result := false;
2084     end
2085     else
2086     begin
2087     try
2088     kazip.ExtractAll(Verzeichnis);
2089     except
2090    
2091     end;
2092     end;
2093     kazip.Close;
2094     progress_position(wartenform.pbr_progress.min);
2095     finally
2096     steuerelementesperren(false);
2097     zeige_wartenform(false);
2098     end;
2099     end;
2100    
2101     procedure TMainForm.m_web_vts_click(Sender: TObject);
2102     begin
2103     shellexecute(application.Handle, 'open', 'http://www.viathinksoft.de/', '', '', sw_normal);
2104     end;
2105    
2106     procedure TMainForm.mm_actions_execute(Sender: TObject);
2107     begin
2108     // platzhalter, damit enabled
2109     end;
2110    
2111     procedure TMainForm.mm_file_execute(Sender: TObject);
2112     begin
2113     // platzhalter, damit enabled
2114     end;
2115    
2116     procedure TMainForm.mm_help_execute(Sender: TObject);
2117     begin
2118     // platzhalter, damit enabled
2119     end;
2120    
2121     procedure TMainForm.m_web_infopages_click(Sender: TObject);
2122     begin
2123     shellexecute(application.Handle, 'open', 'http://www.viathinksoft.de/info/decoder/', '', '', sw_normal);
2124     end;
2125    
2126     procedure TMainForm.m_web_forum_click(Sender: TObject);
2127     begin
2128     shellexecute(application.Handle, 'open', 'http://www.viathinksoft.de/devboard/viewforum.php?f=32', '', '', sw_normal);
2129     end;
2130    
2131     procedure TMainForm.m_help_execute(Sender: TObject);
2132     begin
2133     if fileexists(extractfilepath(application.exename)+'help.html') then
2134     ShellExecute(Application.Handle, 'open', PChar(extractfilepath(application.exename)+'help.html'), '', '', SC_DEFAULT)
2135     else
2136     Application.MessageBox(pchar(GetLangEntry('helpnotfound')), pchar(GetLangEntry('error')), MB_OK + MB_ICONSTOP);
2137     end;
2138    
2139     procedure TMainForm.dropfile_drop(Sender: TObject; ShiftState: TShiftState;
2140     Point: TPoint; var Effect: Integer);
2141     var
2142     i: integer;
2143     begin
2144     effect := DROPEFFECT_NONE; // damit stürzt Windows 95 nicht ab
2145    
2146     steuerelementesperren(true);
2147     zeige_wartenform(true);
2148     try
2149    
2150     if DropFile.Files.Count > 1 then
2151     begin
2152     try
2153     kazip.close;
2154     except
2155    
2156     end;
2157    
2158     if fileexists(GetTempDir+TempPre+mainform.temp_unique_number+TempExtZip) then
2159     deletefile(GetTempDir+TempPre+mainform.temp_unique_number+TempExtZip);
2160     CreateZipFile(GetTempDir+TempPre+mainform.temp_unique_number+TempExtZip);
2161     for i := 0 to dropfile.Files.Count - 1 do
2162     begin
2163     addtozip(dropfile.Files.strings[i], GetTempDir+TempPre+mainform.temp_unique_number+TempExtZip)
2164     end;
2165    
2166     openfile(GetTempDir+TempPre+mainform.temp_unique_number+TempExtZip, GetLangEntry('dateiensammlung'), true);
2167     end
2168     else
2169     begin
2170     if fileexists(dropfile.Files.strings[0]) then
2171     openfile(dropfile.Files.strings[0], '', false);
2172    
2173     if directoryexists(dropfile.Files.strings[0]) then
2174     openfolder(dropfile.Files.strings[0]);
2175     end;
2176    
2177     finally
2178     steuerelementesperren(false);
2179     zeige_wartenform(false);
2180     end;
2181     end;
2182    
2183     procedure TMainForm.edt_passwort_change(Sender: TObject);
2184     var
2185     qu: extended;
2186     r, g: integer;
2187     const
2188     helligkeit: byte = 128;
2189     begin
2190     qu := PassphraseQuality(edt_passwort.Text);
2191    
2192     if qu <= 0.5 then
2193     begin
2194     r := helligkeit;
2195     g := floor(qu*helligkeit*2);
2196     end
2197     else
2198     begin
2199     r := helligkeit-floor((qu-0.5)*helligkeit*2);
2200     g := helligkeit;
2201     end;
2202    
2203     lbl_entropy.Caption := inttostr(round(qu*100)) + '%';
2204     lbl_entropy.font.color := rgb(r, g, 0);
2205    
2206     edt_password2_change(sender);
2207     end;
2208    
2209     procedure TMainForm.m_exit_execute(Sender: TObject);
2210     begin
2211     close;
2212     end;
2213    
2214     // von Krypto Anarkist
2215     procedure TMainForm.edt_passwort2_keypress(Sender: TObject; var Key: Char);
2216     begin
2217     if key = #13 then
2218     begin
2219     Key := #0;
2220     // Ist Shift zusätzlich gedrückt?
2221     if GetKeyState(VK_Shift) and $8000 <> 0 then
2222     PostMessage(Handle, WM_NEXTDLGCTL, 1, 0) //edt_enc_password.SetFocus;
2223     else
2224     if m_encrypt.Enabled then m_encrypt.Click;
2225     end;
2226    
2227     edt_passwort_keypress(sender, key);
2228     end;
2229    
2230     // von Krypto Anarkist
2231     procedure SimulateKeyDown(Key : byte);
2232     begin
2233     keybd_event(Key, 0, 0, 0);
2234     end;
2235    
2236     // von Krypto Anarkist
2237     procedure SimulateKeyUp(Key : byte);
2238     begin
2239     keybd_event(Key, 0, KEYEVENTF_KEYUP, 0);
2240     end;
2241    
2242     // von Krypto Anarkist
2243     procedure SimulateKeystroke(Key : byte; extra : DWORD);
2244     begin
2245     keybd_event(Key,
2246     extra,
2247     0,
2248     0);
2249     keybd_event(Key,
2250     extra,
2251     KEYEVENTF_KEYUP,
2252     0);
2253     end;
2254    
2255     // von Krypto Anarkist
2256     procedure SendKeys(s : string);
2257     var
2258     i : integer;
2259     flag : bool;
2260     w : word;
2261     begin
2262     {Get the state of the caps lock key}
2263     flag := not GetKeyState(VK_CAPITAL) and 1 = 0;
2264     {If the caps lock key is on then turn it off}
2265     if flag then
2266     SimulateKeystroke(VK_CAPITAL, 0);
2267     for i := 1 to Length(s) do begin
2268     w := VkKeyScan(s[i]);
2269     {If there is not an error in the key translation}
2270     if ((HiByte(w) <> $FF) and
2271     (LoByte(w) <> $FF)) then begin
2272     {If the key requires the shift key down - hold it down}
2273     if HiByte(w) and 1 = 1 then
2274     SimulateKeyDown(VK_SHIFT);
2275     {Send the VK_KEY}
2276     SimulateKeystroke(LoByte(w), 0);
2277     {If the key required the shift key down - release it}
2278     if HiByte(w) and 1 = 1 then
2279     SimulateKeyUp(VK_SHIFT);
2280     end;
2281     end;
2282     {if the caps lock key was on at start, turn it back on}
2283     if flag then
2284     SimulateKeystroke(VK_CAPITAL, 0);
2285     end;
2286    
2287     // von Krypto Anarkist
2288     function genGarbageString(chars: integer):string;
2289     var
2290     i: integer;
2291     begin
2292     result := '';
2293     for i := 1 to chars do
2294     result := result + chr(random(95)+32);
2295     end;
2296    
2297     // http://www.dsdt.info/tipps/?id=28
2298     function KeyPressed(Key: Integer): Boolean;
2299     begin
2300     KeyPressed := (GetAsyncKeyState(Key) and $8000 <> 0);
2301     end;
2302    
2303     procedure TMainForm.edt_passwort_enter(Sender: TObject);
2304     begin
2305     if not KeyPressed(vk_Menu) and not KeyPressed(vk_Control) then
2306     begin
2307     tedit(sender).Tag := random(configform.upd_garbarge.Position);
2308     sendKeys(genGarbageString(tedit(sender).Tag));
2309     end;
2310     end;
2311    
2312     // idee von Krypto Anarkist... hat in seiner komponente keypress verwendet, was bugs bei Strg-Kombinationen verursacht hat
2313     procedure TMainForm.edt_passwort_keypress(Sender: TObject; var Key: Char);
2314     begin
2315     if Key = #13 then
2316     begin
2317     if m_encrypt.Enabled then m_encrypt.Click;
2318     if m_decrypt.Enabled then m_decrypt.Click;
2319     end
2320     else
2321     begin
2322     if tedit(sender).Tag > 0 then
2323     begin
2324     tedit(sender).Tag := tedit(sender).Tag - 1;
2325     Key := chr(0);
2326     end
2327     else
2328     begin
2329     if not KeyPressed(vk_Menu) and not KeyPressed(vk_Control) then
2330     begin
2331     tedit(sender).Tag := random(configform.upd_garbarge.Position);
2332     sendKeys(genGarbageString(tedit(sender).Tag));
2333     end;
2334     end;
2335     end;
2336     end;
2337    
2338     procedure TMainForm.form_show(Sender: TObject);
2339     begin
2340     application.Restore;
2341     application.BringToFront;
2342     end;
2343    
2344     procedure TMainForm.steuerelementesperren(sperren: boolean);
2345     begin
2346     steuerelementegesperrt := sperren;
2347    
2348     chk_securedelete.enabled := not sperren;
2349     chk_compress.Enabled := not sperren;
2350     img_type.enabled := not sperren;
2351     img_warning.enabled := not sperren;
2352     lbl_capswarning.enabled := not sperren;
2353     img_error.enabled := not sperren;
2354     lbl_readerror.enabled := not sperren;
2355     lbl_passwort.enabled := not sperren;
2356     lbl_passwort2.enabled := not sperren;
2357     lbl_entropy.Enabled := not sperren;
2358     lbl_equal.enabled := not sperren;
2359     lbl_vle1.enabled := not sperren;
2360     lbl_vle2.enabled := not sperren;
2361     lbl_vle3.enabled := not sperren;
2362     lbl_vle4.enabled := not sperren;
2363     lbl_vle5.enabled := not sperren;
2364     lbl_vle6.enabled := not sperren;
2365     lbl_vle7.enabled := not sperren;
2366     edt_vle1.enabled := not sperren;
2367     edt_vle2.enabled := not sperren;
2368     edt_vle3.enabled := not sperren;
2369     edt_vle4.enabled := not sperren;
2370     edt_vle5.enabled := not sperren;
2371     edt_vle6.enabled := not sperren;
2372     edt_vle7.enabled := not sperren;
2373     mm_file.enabled := not sperren;
2374     mm_dateiensammlung.enabled := not sperren;
2375     mm_actions.enabled := not sperren;
2376     mm_help.enabled := not sperren;
2377     b_encrypt.enabled := not sperren;
2378     b_decrypt.enabled := not sperren;
2379     b_direct.enabled := not sperren;
2380     b_open.enabled := not sperren;
2381     b_folder.enabled := not sperren;
2382     edt_passwort.enabled := not sperren;
2383     edt_passwort2.enabled := not sperren;
2384    
2385     if sperren then
2386     screen.Cursor := crHourGlass
2387     else
2388     screen.Cursor := crDefault;
2389    
2390     application.ProcessMessages;
2391     end;
2392    
2393     procedure TMainForm.tmr_refresh_timer(Sender: TObject);
2394     begin
2395     // Bei einem Test mit meinem Windows 98 System kam es zu Fehlern bei den vle-Editboxen
2396     // nach dem Drag&Drop. Daher werden sie her neu gezeichnet nach OpenFile.
2397    
2398     tmr_refresh.Enabled := false;
2399    
2400     mainform.edt_vle1.Repaint;
2401     mainform.edt_vle2.Repaint;
2402     mainform.edt_vle3.Repaint;
2403     mainform.edt_vle4.Repaint;
2404     mainform.edt_vle5.Repaint;
2405     mainform.edt_vle6.Repaint;
2406     mainform.edt_vle7.Repaint;
2407    
2408     lbl_vle1.Repaint;
2409     lbl_vle2.Repaint;
2410     lbl_vle3.Repaint;
2411     lbl_vle4.Repaint;
2412     lbl_vle5.Repaint;
2413     lbl_vle6.Repaint;
2414     lbl_vle7.Repaint;
2415    
2416     img_error.Repaint;
2417     lbl_readerror.Repaint;
2418     lbl_entropy.Repaint;
2419     lbl_equal.Repaint;
2420     lbl_passwort.Repaint;
2421     lbl_passwort2.Repaint;
2422     edt_passwort.Repaint;
2423     edt_passwort2.Repaint;
2424     chk_securedelete.Repaint;
2425     chk_compress.Repaint;
2426     lbl_capswarning.Repaint;
2427     img_warning.Repaint;
2428     img_type.Repaint;
2429    
2430     b_direct.Repaint;
2431     b_encrypt.Repaint;
2432     b_decrypt.Repaint;
2433     b_open.Repaint;
2434     b_folder.Repaint;
2435    
2436     mainform.Repaint;
2437    
2438     application.ProcessMessages;
2439     end;
2440    
2441     procedure TMainForm.edt_password2_change(Sender: TObject);
2442     begin
2443     if edt_passwort.Text = edt_passwort2.text then
2444     begin
2445     lbl_equal.caption := GetLangEntry('equal');
2446     lbl_equal.Font.Color := clGreen;
2447     end
2448     else
2449     begin
2450     lbl_equal.caption := GetLangEntry('notequal');
2451     lbl_equal.Font.Color := clMaroon;
2452     end;
2453     end;
2454    
2455     procedure TMainForm.edt_dec_password_keypress(Sender: TObject; var Key: Char);
2456     begin
2457     if key = #13 then
2458     begin
2459     key := #0;
2460     m_decrypt.Click;
2461     end;
2462     end;
2463    
2464     procedure TMainForm.edt_enc_password_keypress(Sender: TObject;
2465     var Key: Char);
2466     begin
2467     if key = #13 then
2468     begin
2469     key := #0;
2470     if not GetKeyState(VK_Shift) and $8000 <> 0 then
2471     PostMessage(