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

# Content
1 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(Handle, WM_NEXTDLGCTL, 0, 0); //edt_enc_password2.SetFocus;
2472 end;
2473 end;
2474
2475 procedure TMainForm.tmp_progressdurchlauf_timer(Sender: TObject);
2476 begin
2477 if wartenform.pbr_progress.Position + (wartenform.pbr_progress.max div ttimer(self).tag) >= wartenform.pbr_progress.max then
2478 progress_position(wartenform.pbr_progress.min)
2479 else
2480 progress_position(wartenform.pbr_progress.position + wartenform.pbr_progress.max div ttimer(self).tag);
2481 end;
2482
2483 procedure TMainForm.tmr_capslock_timer(Sender: TObject);
2484 begin
2485 img_warning.visible := IsCapsLockOn;
2486 lbl_capswarning.visible := IsCapsLockOn;
2487 end;
2488
2489 procedure TMainForm.kazip_add(Sender: TObject; ItemName: string);
2490 begin
2491 progress_text(GetLangEntry('zip_folder'), ItemName);
2492 inc(DateienCounter);
2493 application.processmessages;
2494 end;
2495
2496 procedure TMainForm.m_delete_execute(Sender: TObject);
2497 var
2498 res: integer;
2499 old_ersatzname: string;
2500 begin
2501 res := Application.MessageBox(pchar(GetLangEntry('erasewarning')), pchar(GetLangEntry('warning')), MB_YESNOCANCEL + MB_ICONEXCLAMATION);
2502
2503 if res = ID_YES then
2504 begin
2505 zeige_wartenform(true);
2506 steuerelementesperren(true);
2507 try
2508
2509 // Ersatzname bei geöffneten Ordner: X:\BlaBlaBla\xxxx\
2510 // Ersatzname bei DC4-Datei mit Ordner-Flag: xxxx
2511 if (copy(ersatzname, 2, 2) = ':\') then
2512 begin
2513 old_ersatzname := ersatzname;
2514 schliessedatei;
2515 dc_deletedir(old_ersatzname);
2516 if directoryexists(old_ersatzname) then
2517 Application.MessageBox(pchar(GetLangEntry('notdeleted')), pchar(GetLangEntry('error')), MB_OK + MB_ICONSTOP)
2518 else
2519 Application.MessageBox(pchar(GetLangEntry('erasesuccessful')), pchar(GetLangEntry('information')), MB_OK + MB_ICONINFORMATION);
2520 end
2521 else
2522 begin
2523 dc_deletefile(fileopen);
2524 if fileexists(fileopen) then
2525 begin
2526 Application.MessageBox(pchar(GetLangEntry('notdeleted')), pchar(GetLangEntry('error')), MB_OK + MB_ICONSTOP);
2527 end
2528 else
2529 begin
2530 schliessedatei;
2531 Application.MessageBox(pchar(GetLangEntry('erasesuccessful')), pchar(GetLangEntry('information')), MB_OK + MB_ICONINFORMATION);
2532 end;
2533 end;
2534
2535 finally
2536 steuerelementesperren(false);
2537 zeige_wartenform(false);
2538 end;
2539 end;
2540 end;
2541
2542 procedure TMainForm.m_info_execute(Sender: TObject);
2543 begin
2544 AboutForm.PopupParent := Screen.ActiveForm; // http://www.delphipraxis.net/topic75743,0,asc,0.html
2545 AboutForm.showmodal;
2546 end;
2547
2548 procedure TMainForm.m_open_execute(Sender: TObject);
2549 var
2550 i: integer;
2551 begin
2552 if dlg_open.execute then
2553 begin
2554 if dlg_open.Files.Count > 1 then
2555 begin
2556 steuerelementesperren(true);
2557 zeige_wartenform(true);
2558 try
2559
2560 try
2561 kazip.close;
2562 except
2563
2564 end;
2565
2566 if fileexists(GetTempDir+TempPre+mainform.temp_unique_number+TempExtZip) then
2567 deletefile(GetTempDir+TempPre+mainform.temp_unique_number+TempExtZip);
2568 CreateZipFile(GetTempDir+TempPre+mainform.temp_unique_number+TempExtZip);
2569 for i := 0 to dlg_open.Files.Count - 1 do
2570 begin
2571 addtozip(dlg_open.Files.strings[i], GetTempDir+TempPre+mainform.temp_unique_number+TempExtZip)
2572 end;
2573
2574 openfile(GetTempDir+TempPre+mainform.temp_unique_number+TempExtZip, GetLangEntry('dateiensammlung'), true);
2575
2576 finally
2577 steuerelementesperren(false);
2578 zeige_wartenform(false);
2579 end;
2580 end
2581 else
2582 openfile(dlg_open.FileName, '', false);
2583 end;
2584 end;
2585
2586 // http://www.delphipraxis.net/post43515.html
2587 Function GetHTML(AUrl: string): string;
2588 var
2589 databuffer : array[0..4095] of char;
2590 ResStr : string;
2591 hSession, hfile: hInternet;
2592 dwindex,dwcodelen,dwread,dwNumber: cardinal;
2593 dwcode : array[1..20] of char;
2594 res : pchar;
2595 Str : pchar;
2596 begin
2597 ResStr:='';
2598 if pos('http://',lowercase(AUrl))=0 then
2599 AUrl:='http://'+AUrl;
2600
2601 // Hinzugefügt
2602 application.ProcessMessages;
2603
2604 hSession:=InternetOpen('InetURL:/1.0',
2605 INTERNET_OPEN_TYPE_PRECONFIG,
2606 nil,
2607 nil,
2608 0);
2609 if assigned(hsession) then
2610 begin
2611 // Hinzugefügt
2612 application.ProcessMessages;
2613
2614 hfile:=InternetOpenUrl(
2615 hsession,
2616 pchar(AUrl),
2617 nil,
2618 0,
2619 INTERNET_FLAG_RELOAD,
2620 0);
2621 dwIndex := 0;
2622 dwCodeLen := 10;
2623
2624 // Hinzugefügt
2625 application.ProcessMessages;
2626
2627 HttpQueryInfo(hfile,
2628 HTTP_QUERY_STATUS_CODE,
2629 @dwcode,
2630 dwcodeLen,
2631 dwIndex);
2632 res := pchar(@dwcode);
2633 dwNumber := sizeof(databuffer)-1;
2634 if (res ='200') or (res ='302') then
2635 begin
2636 while (InternetReadfile(hfile,
2637 @databuffer,
2638 dwNumber,
2639 DwRead)) do
2640 begin
2641
2642 // Hinzugefügt
2643 application.ProcessMessages;
2644
2645 if dwRead =0 then
2646 break;
2647 databuffer[dwread]:=#0;
2648 Str := pchar(@databuffer);
2649 resStr := resStr + Str;
2650 end;
2651 end
2652 else
2653 ResStr := 'Status:'+res;
2654 if assigned(hfile) then
2655 InternetCloseHandle(hfile);
2656 end;
2657
2658 // Hinzugefügt
2659 application.ProcessMessages;
2660
2661 InternetCloseHandle(hsession);
2662 Result := resStr;
2663 end;
2664
2665 procedure TMainForm.m_web_update_execute(Sender: TObject);
2666 var
2667 temp: string;
2668 begin
2669 zeige_wartenform(true);
2670 steuerelementesperren(true);
2671
2672 progress_position(wartenform.pbr_progress.Min);
2673 progress_text(getlangentry('wait_internet'), '');
2674
2675 ttimer(self).tag := 2;
2676 tmp_progressdurchlauf.Enabled := true;
2677
2678 temp := GetHTML('http://www.viathinksoft.de/update/?id='+updateid);
2679 if copy(temp, 0, 7) = 'Status:' then
2680 begin
2681 tmp_progressdurchlauf.Enabled := false;
2682 zeige_wartenform(false);
2683 steuerelementesperren(false);
2684
2685 Application.MessageBox(pchar(MainForm.GetLangEntry('update_error')), pchar(MainForm.GetLangEntry('error')), MB_OK + MB_ICONERROR)
2686 end
2687 else
2688 begin
2689 if GetHTML('http://www.viathinksoft.de/update/?id='+updateid) <> DC4Ver then
2690 begin
2691 tmp_progressdurchlauf.Enabled := false;
2692 zeige_wartenform(false);
2693 steuerelementesperren(false);
2694
2695 if Application.MessageBox(pchar(MainForm.GetLangEntry('update_yes')), pchar(MainForm.GetLangEntry('information')), MB_YESNO + MB_ICONASTERISK) = ID_YES then
2696 shellexecute(application.handle, 'open', pchar('http://www.viathinksoft.de/update/?id=@'+updateid), '', '', sw_normal);
2697 end
2698 else
2699 begin
2700 tmp_progressdurchlauf.Enabled := false;
2701 zeige_wartenform(false);
2702 steuerelementesperren(false);
2703
2704 Application.MessageBox(pchar(MainForm.GetLangEntry('update_no')), pchar(MainForm.GetLangEntry('information')), MB_OK + MB_ICONASTERISK);
2705 end;
2706 end;
2707 end;
2708
2709 procedure TMainForm.m_web_email_click(Sender: TObject);
2710 begin
2711 shellexecute(application.Handle, 'open', pchar('mailto:info@daniel-marschall.de?subject=(De)Coder '+DC4Ver), '', '', sw_normal);
2712 end;
2713
2714 procedure TMainForm.m_config_execute(Sender: TObject);
2715 begin
2716 ConfigForm.PopupParent := Screen.ActiveForm; // http://www.delphipraxis.net/topic75743,0,asc,0.html
2717 ConfigForm.showmodal;
2718 end;
2719
2720 procedure TProgress.Process(const Min,Max,Pos: Int64);
2721 var
2722 P: Integer;
2723 begin
2724 P := floor((Pos - Min) / (Max - Min) * wartenform.pbr_progress.max);
2725 mainform.progress_position(P);
2726 application.ProcessMessages;
2727 end;
2728
2729 constructor TProgress.Create;
2730 begin
2731 inherited Create;
2732 mainform.progress_position(wartenform.pbr_progress.min);
2733 end;
2734
2735 destructor TProgress.Destroy;
2736 begin
2737 inherited Destroy;
2738 mainform.progress_position(wartenform.pbr_progress.min);
2739 end;
2740
2741 procedure TMainForm.kazip_actions_compress(Sender: TObject; Current,
2742 Total: Integer);
2743 begin
2744 progress_position(floor(wartenform.pbr_progress.max / DateienImOrdner * (DateienCounter + (Current / Total))));
2745 Application.ProcessMessages;
2746 end;
2747
2748 procedure TMainForm.kazip_actions_decompress(Sender: TObject; Current,
2749 Total: Integer);
2750 begin
2751 // Jede einzelne Datei:
2752 // progress_position(floor(Current / Total * wartenform.ProgressBar1.max));
2753
2754 inc(DateienCounter);
2755 progress_position(floor(wartenform.pbr_progress.max / DateienImOrdner * DateienCounter));
2756 Application.ProcessMessages;
2757 end;
2758
2759 procedure TMainForm.form_closequery(Sender: TObject; var CanClose: Boolean);
2760 begin
2761 CanClose := BorderIcons <> [];
2762 end;
2763
2764 procedure TMainForm.m_folder_execute(Sender: TObject);
2765 var
2766 fol: string;
2767 begin
2768 fol := BrowseForFolder(GetLangEntry('foldermessageopen'), true);
2769 if fol <> '' then
2770 OpenFolder(fol);
2771 end;
2772
2773 // http://www.delphipraxis.net/post478066.html#478066
2774 procedure ExecuteProgramm(const PFileName: string);
2775 var
2776 SEInfo: TShellExecuteInfo;
2777 ExitCode: DWORD;
2778 ExecuteFile: string;
2779 begin
2780 ExecuteFile := '"' + PFileName + '"';
2781 FillChar(SEInfo, SizeOf(SEInfo), 0);
2782 SEInfo.cbSize := SizeOf(TShellExecuteInfo);
2783
2784 with SEInfo do
2785 begin
2786 fMask := SEE_MASK_NOCLOSEPROCESS;
2787 Wnd := Application.Handle;
2788 lpFile := PChar(ExecuteFile);
2789 nShow := SW_SHOWNORMAL;
2790 end;
2791
2792 if ShellExecuteEx(@SEInfo) then
2793 begin
2794 repeat
2795 Application.ProcessMessages;
2796 GetExitCodeProcess(SEInfo.hProcess, ExitCode);
2797 until (ExitCode <> STILL_ACTIVE) or
2798 Application.Terminated;
2799 end else
2800 begin
2801 // Application.MessageBox('Fehler beim Starten des Programms', 'Hinweis', MB_OK + MB_ICONERROR);
2802 end;
2803 end;
2804
2805 procedure TMainForm.m_direct_execute(Sender: TObject);
2806 var
2807 ctemp, temp: string;
2808 error: boolean;
2809 begin
2810 zeige_wartenform(true);
2811 steuerelementesperren(true);
2812 try
2813
2814 forcedirectories(GetTempDir+TempDirect+'\'+temp_unique_number+'\');
2815
2816 // Datei
2817 if (flag = DateiTag) or (flag = DateiCompressTag) then
2818 begin
2819 temp := GetTempDir+TempDirect+'\'+temp_unique_number+'\'+edt_vle6.text;
2820 ctemp := GetTempDir+TempPre+temp_unique_number+TempExtCmp;
2821
2822 dc_deletefile(temp);
2823 error := false;
2824 try
2825 if (flag = DateiTag) then
2826 DecodeFile(fileopen, temp, edt_passwort.Text);
2827 if (flag = DateiCompressTag) then
2828 begin
2829 DecodeFile(fileopen, ctemp, edt_passwort.Text);
2830 DeCompress(ctemp, temp);
2831 end;
2832 except
2833 // Kann auftreten, wenn das Programm beim entschlüsseln geschlossen wird
2834 on EDECException do
2835 begin
2836 edt_passwort.Text := '';
2837 edt_passwort.SetFocus; // wirkt durch Exception nicht -.-
2838 error := true;
2839 if bordericons <> [] then raise;
2840 end;
2841 else
2842 error := true;
2843 end;
2844
2845 if not error then
2846 ExecuteProgramm(temp);
2847 end;
2848
2849 // Ordner
2850 if (flag = OrdnerTag) or (flag = OrdnerCompressTag) then
2851 begin
2852 temp := GetTempDir+TempPre+temp_unique_number+TempExtZip;
2853 ctemp := GetTempDir+TempPre+temp_unique_number+TempExtCmp;
2854
2855 dc_deletefile(temp);
2856 error := false;
2857 try
2858 if (flag = OrdnerTag) then
2859 DecodeFile(fileopen, temp, edt_passwort.text);
2860 if (flag = OrdnerCompressTag) then
2861 begin
2862 DecodeFile(fileopen, ctemp, edt_passwort.Text);
2863 DeCompress(ctemp, temp);
2864 end;
2865 except
2866 // Kann auftreten, wenn das Programm beim entschlüsseln geschlossen wird
2867 edt_passwort.Text := '';
2868 edt_passwort.SetFocus; // wirkt durch Exception nicht -.-
2869 error := true;
2870 if bordericons <> [] then raise;
2871 end;
2872
2873 if not error then
2874 begin
2875 if directoryexists(GetTempDir+TempDirect+'\'+temp_unique_number+'\'+edt_vle6.text) then
2876 dc_deletedir(GetTempDir+TempDirect+'\'+temp_unique_number+'\'+edt_vle6.text);
2877 mkdir(GetTempDir+TempDirect+'\'+temp_unique_number+'\'+edt_vle6.text);
2878 if Unzip(temp, GetTempDir+TempDirect+'\'+temp_unique_number+'\'+edt_vle6.text) then
2879 begin
2880 ExecuteProgramm(GetTempDir+TempDirect+'\'+temp_unique_number+'\'+edt_vle6.text);
2881 end;
2882 end;
2883 end;
2884
2885 finally
2886 steuerelementesperren(false);
2887 mainform.zeige_wartenform(false);
2888 end;
2889 end;
2890
2891 procedure TMainForm.m_dateiensammlung_add_file_click(Sender: TObject);
2892 var
2893 i: integer;
2894 begin
2895 if dlg_open_element.Execute then
2896 begin
2897 steuerelementesperren(true);
2898 zeige_wartenform(true);
2899 try
2900
2901 if dlg_open_element.Files.Count > 1 then
2902 begin
2903 for i := 0 to dlg_open_element.Files.Count - 1 do
2904 begin
2905 addtozip(dlg_open_element.Files.Strings[i], fileopen);
2906 end;
2907 end
2908 else
2909 begin
2910 addtozip(dlg_open_element.filename, fileopen);
2911 end;
2912
2913 edt_vle4.Text := BestimmeDateiGroesse(fileopen);
2914
2915 finally
2916 steuerelementesperren(false);
2917 zeige_wartenform(false);
2918 end;
2919 end;
2920 end;
2921
2922 function TMainForm.BestimmeDateiGroesse(filename: string): string;
2923 begin
2924 BestimmeDateiGroesseSource := TFileStream.Create(filename, fmOpenRead or fmShareDenyNone);
2925 try
2926 try
2927 result := IntelligenteDateigroesse(BestimmeDateiGroesseSource.size);
2928 except
2929 result := IntelligenteDateigroesse(0);
2930 end;
2931 finally
2932 BestimmeDateiGroesseSource.free;
2933 end;
2934 end;
2935
2936 procedure TMainForm.m_dateiensammlung_add_folder_click(Sender: TObject);
2937 var
2938 fol: string;
2939 begin
2940 fol := BrowseForFolder(getlangentry('dateisammlung_folder_add_message'), true);
2941 if fol <> '' then
2942 begin
2943 steuerelementesperren(true);
2944 zeige_wartenform(true);
2945 try
2946
2947 addtozip(fol, fileopen);
2948 edt_vle4.Text := BestimmeDateiGroesse(fileopen);
2949
2950 finally
2951 steuerelementesperren(false);
2952 zeige_wartenform(false);
2953 end;
2954 end;
2955 end;
2956
2957 procedure TMainForm.m_dateiensammlung_neu_click(Sender: TObject);
2958 begin
2959 steuerelementesperren(true);
2960 zeige_wartenform(true);
2961 try
2962
2963 try
2964 kazip.close;
2965 except
2966
2967 end;
2968
2969 if fileexists(GetTempDir+TempPre+mainform.temp_unique_number+TempExtZip) then
2970 deletefile(GetTempDir+TempPre+mainform.temp_unique_number+TempExtZip);
2971 CreateZipFile(GetTempDir+TempPre+mainform.temp_unique_number+TempExtZip);
2972
2973 openfile(GetTempDir+TempPre+mainform.temp_unique_number+TempExtZip, GetLangEntry('dateiensammlung'), true);
2974
2975 finally
2976 steuerelementesperren(false);
2977 zeige_wartenform(false);
2978 end;
2979 end;
2980
2981 procedure TMainForm.m_dateiensammlung_show_click(Sender: TObject);
2982 begin
2983 elementeform.PopupParent := Screen.ActiveForm; // http://www.delphipraxis.net/topic75743,0,asc,0.html
2984 elementeform.showmodal;
2985 end;
2986
2987 procedure TMainForm.m_decrypt_execute(Sender: TObject);
2988 var
2989 temp, ctemp, fol, neu: string;
2990 error: boolean;
2991 begin
2992 zeige_wartenform(true);
2993 steuerelementesperren(true);
2994 try
2995
2996 // Datei
2997 if (flag = DateiTag) or (flag = DateiCompressTag) then
2998 begin
2999 temp := GetTempDir+TempPre+temp_unique_number+TempExtTmp;
3000 ctemp := GetTempDir+TempPre+temp_unique_number+TempExtCmp;
3001
3002 dc_deletefile(temp);
3003 error := false;
3004 try
3005 DecodeFile(fileopen, temp, edt_passwort.Text);
3006 if flag = DateiCompressTag then
3007 DeCompress(temp, ctemp)
3008 else
3009 ctemp := temp;
3010 except
3011 // Kann auftreten, wenn das Programm beim entschlüsseln geschlossen wird
3012 on EDECException do
3013 begin
3014 edt_passwort.Text := '';
3015 edt_passwort.SetFocus; // wirkt durch Exception nicht -.-
3016 error := true;
3017 if bordericons <> [] then raise;
3018 end;
3019 else
3020 error := true;
3021 end;
3022
3023 // Wenn es zu keinem Fehler kam,
3024 // dann den User fragen, wohin endgültig speichern
3025 if not error then
3026 begin
3027 if ausgabegesetzt <> '' then
3028 begin
3029 // Ausgabeverzeichnis ist durch Befehlszeileneingabe bereits gesetzt
3030 dc_deletefile(ausgabegesetzt);
3031 if movefile(pchar(ctemp), pchar(ausgabegesetzt)) then
3032 begin
3033 if chk_securedelete.Checked then
3034 begin
3035 dc_deletefile(fileopen);
3036 if fileexists(fileopen) then
3037 errorlevel := 6;
3038 end;
3039 end
3040 else
3041 errorlevel := 5;
3042 end
3043 else
3044 begin
3045 if dlg_save_dec.Execute then
3046 begin
3047 dc_deletefile(dlg_save_dec.FileName);
3048 forcedirectories(extractfilepath(dlg_save_dec.filename));
3049 if movefile(pchar(ctemp), pchar(dlg_save_dec.FileName)) then
3050 begin
3051 if chk_securedelete.Checked then
3052 begin
3053 dc_deletefile(fileopen);
3054 if fileexists(fileopen) then
3055 Application.MessageBox(pchar(GetLangEntry('notdeleted')), pchar(GetLangEntry('warning')), MB_OK + MB_ICONEXCLAMATION)
3056 else
3057 schliessedatei;
3058 end;
3059 end
3060 else
3061 Application.MessageBox(pchar(GetLangEntry('moveerror')), pchar(GetLangEntry('error')), MB_OK + MB_ICONSTOP);
3062 end
3063 end;
3064 end;
3065 end;
3066
3067 // Ordner
3068 if (flag = OrdnerTag) or (flag = OrdnerCompressTag) then
3069 begin
3070 temp := GetTempDir+TempPre+temp_unique_number+TempExtZip;
3071 ctemp := GetTempDir+TempPre+temp_unique_number+TempExtCmp;
3072
3073 dc_deletefile(temp);
3074 error := false;
3075 try
3076 DecodeFile(fileopen, temp, edt_passwort.text);
3077 if flag = OrdnerCompressTag then
3078 begin
3079 DeCompress(temp, ctemp);
3080 dc_deletefile(temp);
3081 movefile(pchar(ctemp), pchar(temp)); // KaZIP kann nur ZIP-Dateien öffnen, keine CMP
3082 end;
3083 except
3084 // Kann auftreten, wenn das Programm beim entschlüsseln geschlossen wird
3085 edt_passwort.Text := '';
3086 edt_passwort.SetFocus; // wirkt durch Exception nicht -.-
3087 error := true;
3088 if bordericons <> [] then raise;
3089 end;
3090
3091 // Wenn es zu keinem Fehler kam,
3092 // dann den User fragen, wohin extrahieren (unzippen)
3093 if not error then
3094 begin
3095 if (ausgabegesetzt <> '') then
3096 begin
3097 if copy(ausgabegesetzt, length(ausgabegesetzt), 1) = '\' then
3098 neu := FindeFreienOrdnernamen(ausgabegesetzt+ersatzname)
3099 else
3100 neu := FindeFreienOrdnernamen(ausgabegesetzt+'\'+ersatzname);
3101 if not ForceDirectories(neu) then
3102 errorlevel := 4 // Ausgabeverzeichnis konnte nicht erstellt werden
3103 else
3104 begin
3105 if Unzip(temp, neu) then
3106 begin
3107 if chk_securedelete.Checked then
3108 begin
3109 dc_deletefile(fileopen);
3110 if fileexists(fileopen) then
3111 errorlevel := 6;
3112 end;
3113 end
3114 else
3115 errorlevel := 7;
3116 end;
3117 end
3118 else
3119 begin
3120 fol := BrowseForFolder(GetLangEntry('foldermessagesave'), true);
3121 if fol <> '' then
3122 begin