Subversion Repositories stackman

Rev

Go to most recent revision | Blame | Last modification | View Log | RSS feed

  1. unit global;
  2.  
  3. interface
  4.  
  5. uses
  6.   SysUtils, Classes, Dialogs, Forms, Windows, ShellAPI, Controls,
  7.   ComCtrls, WinInet;
  8.  
  9. type
  10.   TAMode = (emUnknown, emFolder, emText, emAppender, emForeign);
  11.  
  12. // TODO: So viel wie möglich in den implementation Teil schieben
  13. function allFiles(folder: string): string;
  14. function FilenameToCatname(fil: string): string;
  15. procedure StrokeFromFile(filename: string; index: integer; expected_text: string);
  16. procedure AddToJournal(text: string);
  17. function RemoveForbiddenChars(fn: string; dir: boolean): string;
  18. procedure JournalDeleteEntry(fn: string);
  19. function commonDelete(fn: string): boolean;
  20. procedure commonExternalOpen(fn: string);
  21. function GetUserFriendlyElementName(fn: string): string;
  22. procedure openCategoriesWindow();
  23. procedure newDialog(folder: string);
  24. procedure OpenTextEditor(folder, cat: string);
  25. procedure OpenAppenderEditor(folder, cat: string);
  26. procedure renameDialog(Node: TTreeNode);
  27. function DelTree(DirName : string): Boolean;
  28. function MyAddTrailingPathDelimiter(folder: string): string;
  29. function getDataPath(): string;
  30. function getJournalFileName(): string;
  31. function getAppenderFileName(Folder, Name: string): string;
  32. function getTextFileName(Folder, Name: string): string;
  33. function getFolderName(Folder, Name: string): string;
  34. function GetRelativeNameFromNode(Node: TTreeNode): string;
  35. function GetRelativeFileName(Filename: string): string;
  36. function GetFileNameFromNode(Node: TTreeNode): string;
  37. function GetFolderFromNode(Node: TTreeNode): string;
  38. function IsTextNode(Node: TTreeNode): boolean;
  39. function IsFolderNode(Node: TTreeNode): boolean;
  40. function IsAppenderNode(Node: TTreeNode): boolean;
  41. function IsForeignNode(Node: TTreeNode): boolean;
  42. function IsRootNode(Node: TTreeNode): boolean;
  43. // function GetPersonalFolder(Default: string): string; overload;
  44. function GetPersonalFolder(): string; overload;
  45. function GetCatFromNode(Node: TTreeNode): string;
  46. Function GetHTML(AUrl: string): string;
  47. procedure explode(delim: char; s: string; sl: TStringList);
  48.  
  49. type
  50.   EStrokeUnknown = class(Exception);
  51.   EStrokeMismatch = class(Exception);
  52.   ENodeError = class(Exception);
  53.   EInternalError = class(Exception);
  54.  
  55. resourcestring
  56.   lng_cap_new = 'Neue Datei anlegen';
  57.   lng_cap_rename = 'Umbennen';
  58.   lng_jnl_renamed = 'Umbenannt: "%s" zu "%s".';
  59.   lng_already_exists = 'Fehler! Die Datei "%s" existiert bereits.';
  60.   lng_move_error = 'Fehler! Konnte nicht von "%s" nach "%s" verschieben.';
  61.   lng_jnl_delete = 'LÖSCHE %s';
  62.   lng_content_was = 'Der Inhalt war:';
  63.   lng_no_content = 'Die Datei war leer.';
  64.   lng_jnl_open_external = 'Öffne mit externem Programm: %s';
  65.   lng_jnl_created = 'Erstellt: %s';
  66.   lng_jnl_stroke_from = 'Streiche von %s:';
  67.   lng_jnl_add_to = 'Füge hinzu: %s';
  68.   lng_jnl_textchange = 'Textinhalt geändert: %s';
  69.   lng_filenotfound = 'Datei wurde nicht gefunden.';
  70.   lng_editor_title = '%s - Streichlisteneditor';
  71.   lng_texteditor_title = '%s - AUTOSAVE Texteditor';
  72.   lng_stroker_really = 'Möchten Sie diese %d Zeilen wirklich streichen?';
  73.   lng_refresh_strokes_loss = 'Warnung: Beim Neu-Laden werden alle Streich-Vormerkungen (%d) entfernt. Wirklich neu laden?';
  74.   lng_appendfirst = 'Neue Zeile vor dem Schließen in "%s" ablegen?';
  75.   lng_savefirst = 'Die Änderungen an "%s" abspeichern?';
  76.   lng_strokefirst = '%d markierte Zeilen in "%s" vor dem Schließen streichen?';
  77.   lng_notdeleted = 'Fehler: Datei konnte nicht gelöscht werden!';
  78.   lng_error = 'Ein Fehler ist aufgetreten.';
  79.   lng_journal_error = 'Es konnte nicht in das Journal geschrieben werden!';
  80.   lng_deletethis = 'Datensatz "%s" wirklich löschen?';
  81.   lng_notcreated = 'Fehler: Datei konnte nicht erstellt werden!';
  82.   lng_alreadyexists_open = 'Die Datei existiert bereits. Sie wird nun geöffnet.';
  83.   lng_stroke_mismatch = 'Die zu streichende Zeile stimmt nicht mit der angezeigten Fassung überein.';
  84.   lng_stroke_error = 'Unbekannter Fehler beim Streichen.';
  85.   lng_root = 'Datensätze';
  86.   lng_text = 'Text';
  87.   lng_appender = 'Streichliste';
  88.  
  89. const
  90.   app_pfx = 'app_';
  91.   txt_pfx = 'tex_';
  92.   c_length_of_pfx = Length(app_pfx); // = Length(txt_pfx)
  93.   II_APPENDER = 0;
  94.   II_TEXT = 1;
  95.   II_FOLDER = 2;
  96.   II_FOREIGN = 3;
  97.   II_ROOT = 4;
  98.   FOLDER_VIEWER = 'Explorer';
  99.  
  100. // Konfiguration
  101. const
  102.   CfgExpandNodesAtBeginning = false;
  103.   CfgOpenCatWhenEverythingClosed = false;
  104.   CfgAppenderAllowEmptyLines = true;
  105.  
  106. implementation
  107.  
  108. uses
  109.   categories, journal, name, appender, texteditor;
  110.  
  111. resourcestring
  112.   lng_internal_prefix_length_error = 'Entwicklungstechnischer Fehler! Präfixe dürfen nicht unterschiedlich lang sein!';
  113.   lng_internal_unknown_node_type_error = 'Programminterner Fehler! Node-Typ unbekannt!';
  114.  
  115. function GetModeFromNode(ANode: TTreeNode): TAMode; forward;
  116. function getFileName(mode: TAMode; folder, name: string): string; forward;
  117. function ExtractFileNameWithoutExt(fil: string): string; forward;
  118. function getRawFileName(folder, name: string): string; forward;
  119. function Quote(arg: string): string; forward;
  120.  
  121. function allFiles(folder: string): string;
  122. begin
  123.   result := getRawFilename(folder, '*');
  124. end;
  125.  
  126. function ExtractFileNameWithoutExt(fil: string): string;
  127. begin
  128.   result := Copy(ExtractFileName(fil), 1, Length(ExtractFileName(fil))-Length(ExtractFileExt(fil)));
  129. end;
  130.  
  131. function FilenameToCatname(fil: string): string;
  132. begin
  133.   result := ExtractFileNameWithoutExt(fil);
  134.   result := Copy(result, 1+c_length_of_pfx, length(result)-c_length_of_pfx);
  135.   result := ExtractFilePath(fil) + result;
  136. end;
  137.  
  138. procedure StrokeFromFile(filename: string; index: integer; expected_text: string);
  139. var
  140.   str: TStrings;
  141. begin
  142.   str := TStringList.Create;
  143.   try
  144.     try
  145.       str.LoadFromFile(filename);
  146.       if str.Strings[index] = expected_text then
  147.         str.Delete(index)
  148.       else
  149.         raise EStrokeMismatch.Create(lng_stroke_mismatch);
  150.       str.SaveToFile(filename);
  151.     except
  152.       on E: EStrokeMismatch do
  153.         raise
  154.       else
  155.         raise EStrokeUnknown.Create(lng_stroke_error);
  156.     end;
  157.   finally
  158.     str.Free;
  159.   end;
  160. end;
  161.  
  162. procedure AddToJournal(text: string);
  163. var
  164.   f: TextFile;
  165.   l: string;
  166.   i: integer;
  167. begin
  168.   l := Format('[%s] %s', [DateTimeToStr(Now()), text]);
  169.  
  170.   try
  171.     AssignFile(f, getJournalFileName());
  172.     try
  173.       if FileExists(getJournalFileName()) then
  174.         Append(f)
  175.       else
  176.         ReWrite(f);
  177.       WriteLn(f, l);
  178.     finally
  179.       CloseFile(f);
  180.     end;
  181.   except
  182.     ShowMessage(lng_journal_error);
  183.   end;
  184.  
  185.   // Andere Forms benachrichtigen
  186.  
  187.   for i := Screen.FormCount - 1 downto 0 do
  188.   begin
  189.     if Screen.Forms[i] is TMDIJournalForm then
  190.     begin
  191.       TMDIJournalForm(Screen.Forms[i]).DoRefresh;
  192.       break;
  193.     end
  194.   end;
  195. end;
  196.  
  197. function RemoveForbiddenChars(fn: string; dir: boolean): string;
  198. begin
  199.   result := fn;
  200.   fn := StringReplace(fn, '<', '_', [rfReplaceAll]);
  201.   fn := StringReplace(fn, '>', '_', [rfReplaceAll]);
  202.   fn := StringReplace(fn, '|', '_', [rfReplaceAll]);
  203.   fn := StringReplace(fn, '"', '_', [rfReplaceAll]);
  204.   fn := StringReplace(fn, '?', '_', [rfReplaceAll]);
  205.   fn := StringReplace(fn, ':', '_', [rfReplaceAll]);
  206.   fn := StringReplace(fn, '/', '_', [rfReplaceAll]);
  207.   if not dir then fn := StringReplace(fn, '\', '_', [rfReplaceAll]);
  208.   fn := StringReplace(fn, '*', '_', [rfReplaceAll]);
  209. end;
  210.  
  211. procedure JournalDeleteEntry(fn: string);
  212. var
  213.   dump: TStringList;
  214.   i: integer;
  215. begin
  216.   if not fileexists(fn) then exit;
  217.  
  218.   AddToJournal(Format(lng_jnl_delete, [GetUserFriendlyElementName(fn)]));
  219.  
  220.   dump := TStringList.Create;
  221.   try
  222.     dump.LoadFromFile(fn);
  223.  
  224.     if dump.Count > 0 then
  225.     begin
  226.       AddToJournal(lng_content_was);
  227.       for i := 0 to dump.Count - 1 do
  228.       begin
  229.         AddToJournal('- ' + dump.Strings[i]);
  230.       end;
  231.     end
  232.     else
  233.     begin
  234.       AddToJournal(lng_no_content);
  235.     end;
  236.   finally
  237.     dump.Free;
  238.   end;
  239. end;
  240.  
  241. function commonDelete(fn: string): boolean;
  242. var
  243.   userResponse: integer;
  244. begin
  245.   result := false;
  246.  
  247.   userResponse := MessageDlg(Format(lng_deletethis, [GetRelativeFileName(fn)]),
  248.     mtConfirmation, mbYesNoCancel, 0);
  249.  
  250.   if userResponse = idYes then
  251.   begin
  252.     JournalDeleteEntry(fn);
  253.  
  254.     if fileexists(fn) then
  255.     begin
  256.       DeleteFile(PChar(fn));
  257.     end
  258.     else if directoryexists(fn) then
  259.     begin
  260.       DelTree(fn);
  261.     end;
  262.  
  263.     if FileExists(fn) or DirectoryExists(fn) then
  264.     begin
  265.       ShowMessage(lng_notdeleted);
  266.       Exit;
  267.     end;
  268.  
  269.     result := true;
  270.   end;
  271. end;
  272.  
  273. function GetUserFriendlyElementName(fn: string): string;
  274. begin
  275.   result := GetRelativeFileName(fn); // TODO: Benutzer soll was anderes sehen als die Dateinamenserweiterungen
  276. end;
  277.  
  278. procedure commonExternalOpen(fn: string);
  279. begin
  280.   AddToJournal(Format(lng_jnl_open_external, [GetUserFriendlyElementName(fn)]));
  281.  
  282.   if FileExists(fn) then
  283.   begin
  284.     ShellExecute(Application.Handle, 'open', PChar(fn), '',
  285.       PChar(Quote(fn)), SW_NORMAL);
  286.   end
  287.   else if DirectoryExists(fn) then
  288.   begin
  289.     ShellExecute(Application.Handle, 'open', FOLDER_VIEWER,
  290.       PChar(Quote(fn)), '', SW_NORMAL);
  291.   end
  292.   else
  293.   begin
  294.     ShowMessage(lng_filenotfound);
  295.   end;
  296. end;
  297.  
  298. procedure openCategoriesWindow();
  299. var
  300.   i: integer;
  301.   somethingfound: boolean;
  302. begin
  303.   somethingfound := false;
  304.  
  305.   for i := Screen.FormCount - 1 downto 0 do
  306.   begin
  307.     if Screen.Forms[i] is TMDICategories then
  308.     begin
  309.       TMDICategories(Screen.Forms[i]).RefreshList;
  310.       Screen.Forms[i].BringToFront;
  311.       Screen.Forms[i].WindowState := wsNormal;
  312.       somethingfound := true;
  313.       break;
  314.     end
  315.   end;
  316.  
  317.   if not somethingfound then
  318.   begin
  319.     TMDICategories.Create(Application);
  320.   end;
  321. end;
  322.  
  323. procedure newDialog(folder: string);
  324. var
  325.   f: TextFile;
  326.   realfolder, new_folder, new_cat: string;
  327.   i: integer;
  328.   new_fn: string;
  329.   em: TAMode;
  330.   beschreibung: string;
  331. begin
  332.   NameDlg.Caption := lng_cap_new;
  333.   NameDlg.NameEdt.Text := '';
  334.   NameDlg.Textmode.Checked := false;
  335.   NameDlg.Textmode.Enabled := true;
  336.  
  337.   if NameDlg.ShowModal = mrOk then
  338.   begin
  339.     new_cat := ExtractFileName(namedlg.NameEdt.Text);
  340.     new_cat := RemoveForbiddenChars(new_cat, false);
  341.  
  342.     folder := MyAddTrailingPathDelimiter(folder);
  343.  
  344.     new_folder := ExtractFilePath(namedlg.NameEdt.Text);
  345.     new_folder := RemoveForbiddenChars(folder + new_folder, true);
  346.  
  347.     if NameDlg.Textmode.Checked then
  348.     begin
  349.       new_fn := getTextFileName(new_folder, new_cat);
  350.       em := emText;
  351.       beschreibung := lng_text;
  352.     end
  353.     else
  354.     begin
  355.       new_fn := getAppenderFileName(new_folder, new_cat);
  356.       em := emAppender;
  357.       beschreibung := lng_appender;
  358.     end;
  359.  
  360.     new_fn := RemoveForbiddenChars(new_fn, false);
  361.  
  362.     realfolder := ExtractFilePath(new_fn);
  363.     ForceDirectories(realfolder);
  364.  
  365.     if FileExists(new_fn) then
  366.     begin
  367.       ShowMessage(lng_alreadyexists_open);
  368.       if em = emText then
  369.         OpenTextEditor(new_folder, new_cat)
  370.       else
  371.         OpenAppenderEditor(new_folder, new_cat);
  372.       Exit;
  373.     end;
  374.  
  375.     AssignFile(f, new_fn);
  376.     ReWrite(f);
  377.     CloseFile(f);
  378.  
  379.     if not FileExists(new_fn) then
  380.     begin
  381.       ShowMessage(lng_notcreated);
  382.       Exit;
  383.     end;
  384.  
  385.     AddToJournal(Format(lng_jnl_created, [GetUserFriendlyElementName(new_fn)]));
  386.  
  387.     for i := Screen.FormCount - 1 downto 0 do
  388.     begin
  389.       if Screen.Forms[i] is TMDICategories then
  390.       begin
  391.         // TMDICategories(Screen.Forms[i]).RefreshList;
  392.  
  393.         TMDICategories(Screen.Forms[i]).InsertNode(new_folder, new_cat, em);
  394.       end
  395.     end;
  396.  
  397.     if em = emText then
  398.       OpenTextEditor(new_folder, new_cat)
  399.     else
  400.       OpenAppenderEditor(new_folder, new_cat);
  401.   end;
  402. end;
  403.  
  404. procedure OpenTextEditor(folder, cat: string);
  405. var
  406.   somethingfound: boolean;
  407.   i: integer;
  408. begin
  409.   somethingfound := false;
  410.  
  411.   for i := Screen.FormCount - 1 downto 0 do
  412.   begin
  413.     if Screen.Forms[i] is TMDITextEditor then
  414.     begin
  415.       if (TMDITextEditor(Screen.Forms[i]).cat = cat) and
  416.          (TMDITextEditor(Screen.Forms[i]).folder = folder) then
  417.       begin
  418.         Screen.Forms[i].BringToFront;
  419.         Screen.Forms[i].WindowState := wsNormal;
  420.         somethingfound := true;
  421.         break;
  422.       end;
  423.     end
  424.   end;
  425.  
  426.   if not somethingfound then
  427.   begin
  428.     TMDITextEditor.Create(Application, folder, cat);
  429.   end;
  430. end;
  431.  
  432. procedure OpenAppenderEditor(folder, cat: string);
  433. var
  434.   somethingfound: boolean;
  435.   i: integer;
  436. begin
  437.   somethingfound := false;
  438.  
  439.   for i := Screen.FormCount - 1 downto 0 do
  440.   begin
  441.     if Screen.Forms[i] is TMDIAppender then
  442.     begin
  443.       if (TMDIAppender(Screen.Forms[i]).cat = cat) and
  444.          (TMDIAppender(Screen.Forms[i]).folder = folder) then
  445.       begin
  446.         Screen.Forms[i].BringToFront;
  447.         Screen.Forms[i].WindowState := wsNormal;
  448.         somethingfound := true;
  449.         break;
  450.       end;
  451.     end
  452.   end;
  453.  
  454.   if not somethingfound then
  455.   begin
  456.     TMDIAppender.Create(Application, folder, cat);
  457.   end;
  458. end;
  459.  
  460. function GetModeFromNode(ANode: TTreeNode): TAMode;
  461. begin
  462.   result := emUnknown;
  463.  
  464.   if IsAppenderNode(ANode) then
  465.   begin
  466.     result := emAppender;
  467.   end
  468.   else if IsTextNode(ANode) then
  469.   begin
  470.     result := emText;
  471.   end
  472.   else if IsFolderNode(ANode) then
  473.   begin
  474.     result := emFolder;
  475.   end else if IsForeignNode(ANode) then
  476.   begin
  477.     result := emForeign;
  478.   end;
  479.  
  480.   if result = emUnknown then
  481.   begin
  482.     raise ENodeError.Create(lng_internal_unknown_node_type_error);
  483.   end;
  484. end;
  485.  
  486. function getFileName(mode: TAMode; folder, name: string): string;
  487. begin
  488.   if (mode = emFolder) or (mode = emForeign) then
  489.   begin
  490.     result := getFolderName(folder, name);
  491.     result := RemoveForbiddenChars(result, true);
  492.   end
  493.   else if mode = emText then
  494.   begin
  495.     result := getTextFileName(folder, name);
  496.     result := RemoveForbiddenChars(result, false);
  497.   end
  498.   else if mode = emAppender then
  499.   begin
  500.     result := getAppenderFileName(folder, name);
  501.     result := RemoveForbiddenChars(result, false);
  502.   end
  503.   else
  504.   begin
  505.     raise ENodeError.Create(lng_internal_unknown_node_type_error);
  506.   end;
  507. end;
  508.  
  509. procedure renameDialog(Node: TTreeNode);
  510. var
  511.   realfolder, new_cat, new_folder: string;
  512.   i: integer;
  513.   tofile, fromfile: string;
  514.   old_folder, old_cat: string;
  515.   old_em, new_em: TAMode;
  516. const
  517.   folder = ''; // Wir gehen beim Umbenennen von der Wurzel aus
  518. begin
  519.   old_em := GetModeFromNode(Node);
  520.   old_folder := GetFolderFromNode(Node);
  521.   old_cat := GetCatFromNode(Node);
  522.  
  523.   NameDlg.Caption := lng_cap_rename;
  524.   NameDlg.NameEdt.Text := old_folder + old_cat;
  525.   NameDlg.Textmode.Checked := IsTextNode(Node);
  526.   NameDlg.Textmode.Enabled := not IsFolderNode(Node) and not IsForeignNode(Node);
  527.  
  528.   if NameDlg.ShowModal = mrOk then
  529.   begin
  530.     if IsFolderNode(Node) or IsForeignNode(Node) then
  531.     begin
  532.       new_em := old_em;
  533.     end
  534.     else
  535.     begin
  536.       if NameDlg.Textmode.Checked then
  537.         new_em := emText
  538.       else
  539.         new_em := emAppender;
  540.     end;
  541.  
  542.     new_cat := ExtractFileName(namedlg.NameEdt.Text);
  543.     new_cat := RemoveForbiddenChars(new_cat, false);
  544.  
  545.     // folder := MyAddTrailingPathDelimiter(folder);
  546.  
  547.     new_folder := ExtractFilePath(namedlg.NameEdt.Text);
  548.     new_folder := RemoveForbiddenChars(folder + new_folder, true);
  549.  
  550.     realfolder := ExtractFilePath(getFileName(old_em, new_folder, new_cat));
  551.     if not IsFolderNode(Node) then ForceDirectories(realfolder);
  552.  
  553.     // Enthält RemoveForbiddenChars()
  554.     fromfile := getFileName(old_em, old_folder, old_cat);
  555.     tofile := getFileName(new_em, new_folder, new_cat);
  556.  
  557.     if fromfile = tofile then exit;
  558.  
  559.     if fileExists(tofile) then
  560.     begin
  561.       ShowMessageFmt(lng_already_exists, [GetUserFriendlyElementName(tofile)]);
  562.       Exit;
  563.     end;
  564.  
  565.     if not moveFile(pchar(fromfile), pchar(tofile)) then
  566.     begin
  567.       ShowMessageFmt(lng_move_error, [GetUserFriendlyElementName(fromfile), GetUserFriendlyElementName(tofile)]);
  568.       Exit;
  569.     end;
  570.  
  571.     AddToJournal(Format(lng_jnl_renamed, [GetUserFriendlyElementName(fromfile), GetUserFriendlyElementName(tofile)]));
  572.  
  573.     for i := Screen.FormCount - 1 downto 0 do
  574.     begin
  575.       if Screen.Forms[i] is TMDICategories then
  576.       begin
  577.         // TMDICategories(Screen.Forms[i]).RefreshList;
  578.  
  579.         TMDICategories(Screen.Forms[i]).DeleteNode(old_folder, old_cat);
  580.         TMDICategories(Screen.Forms[i]).InsertNode(new_folder, new_cat, new_em);
  581.       end
  582.     end;
  583.  
  584.     Node.Selected := true;
  585.   end;
  586. end;
  587.  
  588. // http://delphi.about.com/cs/adptips1999/a/bltip1199_2.htm
  589. // Modifiziert
  590. Function DelTree(DirName : string): Boolean;
  591. var
  592.   SHFileOpStruct : TSHFileOpStruct;
  593.   DirBuf : array [0..MAX_PATH] of char;
  594. begin
  595.   // Backslash am Ende entfernen
  596.   if Copy(DirName, length(DirName), 1) = PathDelim then
  597.     DirName := Copy(DirName, 1, Length(DirName)-1);
  598.  
  599.   try
  600.     Fillchar(SHFileOpStruct, SizeOf(SHFileOpStruct), 0);
  601.     FillChar(DirBuf, SizeOf(DirBuf), 0);
  602.     StrPCopy(DirBuf, DirName);
  603.     with SHFileOpStruct do
  604.     begin
  605.       Wnd := 0;
  606.       pFrom := @DirBuf;
  607.       wFunc := FO_DELETE;
  608.       fFlags := FOF_ALLOWUNDO;
  609.       fFlags := fFlags or FOF_NOCONFIRMATION;
  610.       fFlags := fFlags or FOF_SILENT;
  611.     end;
  612.     Result := (SHFileOperation(SHFileOpStruct) = 0);
  613.   except
  614.     Result := False;
  615.   end;
  616. end;
  617.  
  618. function MyAddTrailingPathDelimiter(folder: string): string;
  619. begin
  620.   result := folder;
  621.  
  622.   if folder = '' then exit;
  623.  
  624.   result := IncludeTrailingPathDelimiter(folder);
  625.  
  626.   //if Copy(folder, length(folder), 1) <> PathDelim then
  627.   //  result := result + PathDelim;
  628. end;
  629.  
  630. function getDataPath(): string;
  631. const
  632.   DataDirName = 'StackMan-Data';
  633. begin
  634.   if directoryExists(DataDirName) then
  635.     result := DataDirName + PathDelim
  636.   else
  637.     result := GetPersonalFolder() + DataDirName + PathDelim;
  638. end;
  639.  
  640. function getJournalFileName(): string;
  641. const
  642.   JournalFile = 'Journal.txt';
  643. begin
  644.   result := getDataPath() + JournalFile;
  645. end;
  646.  
  647. function getRawFileName(folder, name: string): string;
  648. begin
  649.   Folder := MyAddTrailingPathDelimiter(folder);
  650.   result := getDataPath() + Folder + name;
  651. end;
  652.  
  653. function getAppenderFileName(Folder, Name: string): string;
  654. begin
  655.   result := getRawFileName(folder, app_pfx + Name + '.txt');
  656. end;
  657.  
  658. function getTextFileName(Folder, Name: string): string;
  659. begin
  660.   result := getRawFileName(folder, txt_pfx + Name + '.txt');
  661. end;
  662.  
  663. function getFolderName(Folder, Name: string): string;
  664. begin
  665.   result := getRawFileName(folder, Name);
  666. end;
  667.  
  668. function GetRelativeFileName(Filename: string): string;
  669. var
  670.   datadir: string;
  671. begin
  672.   result := filename;
  673.   datadir := getDataPath();
  674.  
  675.   if LowerCase(copy(result, 1, length(datadir))) = LowerCase(datadir) then
  676.   begin
  677.     result := copy(result, 1+length(datadir), length(result)-length(datadir));
  678.   end;
  679. end;
  680.  
  681. function GetRelativeNameFromNode(Node: TTreeNode): string;
  682. begin
  683.   result := getFilenameFromNode(Node);
  684.   result := GetRelativeFileName(result);
  685.   // result := FilenameToCatname(result);
  686. end;
  687.  
  688. function IsTextNode(Node: TTreeNode): boolean;
  689. begin
  690.   result := Node.ImageIndex = II_TEXT;
  691. end;
  692.  
  693. function IsFolderNode(Node: TTreeNode): boolean;
  694. begin
  695.   result := Node.ImageIndex = II_FOLDER;
  696. end;
  697.  
  698. function IsAppenderNode(Node: TTreeNode): boolean;
  699. begin
  700.   result := Node.ImageIndex = II_APPENDER;
  701. end;
  702.  
  703. function IsForeignNode(Node: TTreeNode): boolean;
  704. begin
  705.   result := Node.ImageIndex = II_FOREIGN;
  706. end;
  707.  
  708. function IsRootNode(Node: TTreeNode): boolean;
  709. begin
  710.   result := Node.ImageIndex = II_ROOT;
  711. end;
  712.  
  713. function GetFileNameFromNode(Node: TTreeNode): string;
  714. var
  715.   folder: string;
  716. begin
  717.   folder := GetFolderFromNode(Node);
  718.  
  719.   if IsTextNode(Node) then
  720.   begin
  721.     result := GetTextFileName(folder, GetCatFromNode(Node));
  722.   end
  723.   else if IsAppenderNode(Node) then
  724.   begin
  725.     result := GetAppenderFileName(folder, GetCatFromNode(Node));
  726.   end
  727.   else if IsForeignNode(Node) then
  728.   begin
  729.     result := GetRawFileName(folder, GetCatFromNode(Node));
  730.   end
  731.   else if isRootNode(Node) then
  732.   begin
  733.     result := getDataPath();
  734.   end
  735.   else if IsFolderNode(Node) then
  736.   begin
  737.     result := GetRawFileName(folder, '');
  738.   end
  739.   else
  740.   begin
  741.     raise ENodeError.Create(lng_internal_unknown_node_type_error);
  742.   end;
  743. end;
  744.  
  745. function GetFolderFromNode(Node: TTreeNode): string;
  746. var
  747.   par: TTreeNode;
  748. begin
  749.   if isRootNode(node) then exit;
  750.   if isFolderNode(node) then
  751.     par := node
  752.   else
  753.     par := node.Parent;
  754.   while not isRootNode(par) do
  755.   begin
  756.     result := par.Text + PathDelim + result;
  757.     par := par.Parent;
  758.   end;
  759. end;
  760.  
  761. function Quote(arg: string): string;
  762. begin
  763.   result := '"' + arg + '"';
  764. end;
  765.  
  766. (* function GetPersonalFolder: string;
  767. var
  768.   path : array [0..MAX_PATH] of char;
  769. begin
  770.   SHGetSpecialFolderPath(0, @path, CSIDL_PERSONAL, false);
  771.   if path = '' then
  772.     result := ExtractFilePath(Application.ExeName)
  773.   else
  774.     result := IncludeTrailingPathDelimiter(path);
  775. end; *)
  776.  
  777. function GetPersonalFolder(DefaultPath: string): string; overload;
  778. // This function replaces SHGetSpecialFolderPath from ShlObj.pas .
  779. // It dynamically loads the DLL, so that also Windows 95 without
  780. // Internet Explorer 4 Extension can work with it.
  781. type
  782.   TSHGetSpecialFolderPath = function(hwndOwner: HWND; lpszPath: PChar;
  783.     nFolder: Integer; fCreate: BOOL): BOOL; stdcall;
  784.    
  785.   procedure Fail;
  786.   begin
  787.     if DefaultPath = '' then
  788.       result := ExtractFilePath(ParamStr(0))
  789.     else
  790.       result := IncludeTrailingPathDelimiter(DefaultPath);
  791.   end;
  792.  
  793. const
  794. {$IFDEF MSWINDOWS}
  795.   shell32 = 'shell32.dll';
  796. {$ENDIF}
  797. {$IFDEF LINUX}
  798.   shell32 = 'libshell32.borland.so';
  799. {$ENDIF}
  800. CSIDL_PERSONAL = $0005;
  801. var
  802.   SpecialFolder: TSHGetSpecialFolderPath;
  803.   Handle: THandle;
  804.   path: array [0..MAX_PATH] of char;
  805. begin
  806.   result := '';
  807.   Handle := LoadLibrary(shell32);
  808.   if Handle <> 0 then
  809.   begin
  810.     {$IFDEF UNICODE}
  811.     @SpecialFolder := GetProcAddress(Handle, 'SHGetSpecialFolderPathW');
  812.     {$ELSE}
  813.     @SpecialFolder := GetProcAddress(Handle, 'SHGetSpecialFolderPathA');
  814.     {$ENDIF}
  815.     if @SpecialFolder <> nil then
  816.     begin
  817.       FillChar(path, sizeof(path), 0);
  818.       if SpecialFolder(0, @path, CSIDL_PERSONAL, false) and (path <> '') then
  819.       begin
  820.         result := IncludeTrailingPathDelimiter(path)
  821.       end
  822.       else
  823.       begin
  824.         Fail;
  825.       end;
  826.     end
  827.     else
  828.     begin
  829.       Fail;
  830.     end;
  831.     FreeLibrary(Handle);
  832.   end
  833.   else
  834.   begin
  835.     Fail;
  836.   end;
  837. end;
  838.  
  839. function GetPersonalFolder(): string;
  840. begin
  841.   result := GetPersonalFolder('C:\');
  842. end;
  843.  
  844. function GetCatFromNode(Node: TTreeNode): string;
  845. begin
  846.   if IsFolderNode(Node) then
  847.     result := ''
  848.   else
  849.     result := Node.Text;
  850. end;
  851.  
  852. // http://www.delphipraxis.net/post43515.html
  853. Function GetHTML(AUrl: string): string;
  854. var
  855.   databuffer : array[0..4095] of char;
  856.   ResStr : string;
  857.   hSession, hfile: hInternet;
  858.   dwindex,dwcodelen,dwread,dwNumber: cardinal;
  859.   dwcode : array[1..20] of char;
  860.   res    : pchar;
  861.   Str    : pchar;
  862. begin
  863.   ResStr:='';
  864.   if system.pos('http://',lowercase(AUrl))=0 then
  865.      AUrl:='http://'+AUrl;
  866.  
  867.   // Hinzugefügt
  868.   application.ProcessMessages;
  869.  
  870.   hSession:=InternetOpen('InetURL:/1.0',
  871.                          INTERNET_OPEN_TYPE_PRECONFIG,
  872.                          nil,
  873.                          nil,
  874.                          0);
  875.   if assigned(hsession) then
  876.   begin
  877.     // Hinzugefügt
  878.     application.ProcessMessages;
  879.  
  880.     hfile:=InternetOpenUrl(
  881.            hsession,
  882.            pchar(AUrl),
  883.            nil,
  884.            0,
  885.            INTERNET_FLAG_RELOAD,
  886.            0);
  887.     dwIndex  := 0;
  888.     dwCodeLen := 10;
  889.  
  890.     // Hinzugefügt
  891.     application.ProcessMessages;
  892.  
  893.     HttpQueryInfo(hfile,
  894.                   HTTP_QUERY_STATUS_CODE,
  895.                   @dwcode,
  896.                   dwcodeLen,
  897.                   dwIndex);
  898.     res := pchar(@dwcode);
  899.     dwNumber := sizeof(databuffer)-1;
  900.     if (res ='200') or (res ='302') then
  901.     begin
  902.       while (InternetReadfile(hfile,
  903.                               @databuffer,
  904.                               dwNumber,
  905.                               DwRead)) do
  906.       begin
  907.  
  908.         // Hinzugefügt
  909.         application.ProcessMessages;
  910.  
  911.         if dwRead =0 then
  912.           break;
  913.         databuffer[dwread]:=#0;
  914.         Str := pchar(@databuffer);
  915.         resStr := resStr + Str;
  916.       end;
  917.     end
  918.     else
  919.       ResStr := 'Status:'+res;
  920.     if assigned(hfile) then
  921.       InternetCloseHandle(hfile);
  922.   end;
  923.  
  924.   // Hinzugefügt
  925.   application.ProcessMessages;
  926.  
  927.   InternetCloseHandle(hsession);
  928.   Result := resStr;
  929. end;
  930.  
  931. procedure explode(delim: char; s: string; sl: TStringList);
  932. var
  933.   i: integer;
  934.   tmp: string;
  935. begin
  936.   tmp := '';
  937.   for i := 1 to length(s) do
  938.   begin
  939.     if s[i] = delim then
  940.     begin
  941.       sl.Add(tmp);
  942.       tmp := '';
  943.     end
  944.     else
  945.       tmp := tmp + s[i];
  946.   end;
  947.   sl.Add(tmp);
  948. end;
  949.  
  950. begin
  951.   if Length(app_pfx) <> Length(txt_pfx) then
  952.   begin
  953.     raise EInternalError.Create(lng_internal_prefix_length_error);
  954.     Halt;
  955.   end;
  956. end.
  957.  
  958.  
  959.  
  960.  
  961.