Subversion Repositories stackman

Compare Revisions

Problem with comparison.

Regard whitespace Rev HEAD → Rev 1

/trunk/global.pas
0,0 → 1,960
unit global;
 
interface
 
uses
SysUtils, Classes, Dialogs, Forms, Windows, ShellAPI, Controls,
ComCtrls, WinInet;
 
type
TAMode = (emUnknown, emFolder, emText, emAppender, emForeign);
 
// TODO: So viel wie möglich in den implementation Teil schieben
function allFiles(folder: string): string;
function FilenameToCatname(fil: string): string;
procedure StrokeFromFile(filename: string; index: integer; expected_text: string);
procedure AddToJournal(text: string);
function RemoveForbiddenChars(fn: string; dir: boolean): string;
procedure JournalDeleteEntry(fn: string);
function commonDelete(fn: string): boolean;
procedure commonExternalOpen(fn: string);
function GetUserFriendlyElementName(fn: string): string;
procedure openCategoriesWindow();
procedure newDialog(folder: string);
procedure OpenTextEditor(folder, cat: string);
procedure OpenAppenderEditor(folder, cat: string);
procedure renameDialog(Node: TTreeNode);
function DelTree(DirName : string): Boolean;
function MyAddTrailingPathDelimiter(folder: string): string;
function getDataPath(): string;
function getJournalFileName(): string;
function getAppenderFileName(Folder, Name: string): string;
function getTextFileName(Folder, Name: string): string;
function getFolderName(Folder, Name: string): string;
function GetRelativeNameFromNode(Node: TTreeNode): string;
function GetRelativeFileName(Filename: string): string;
function GetFileNameFromNode(Node: TTreeNode): string;
function GetFolderFromNode(Node: TTreeNode): string;
function IsTextNode(Node: TTreeNode): boolean;
function IsFolderNode(Node: TTreeNode): boolean;
function IsAppenderNode(Node: TTreeNode): boolean;
function IsForeignNode(Node: TTreeNode): boolean;
function IsRootNode(Node: TTreeNode): boolean;
// function GetPersonalFolder(Default: string): string; overload;
function GetPersonalFolder(): string; overload;
function GetCatFromNode(Node: TTreeNode): string;
Function GetHTML(AUrl: string): string;
procedure explode(delim: char; s: string; sl: TStringList);
 
type
EStrokeUnknown = class(Exception);
EStrokeMismatch = class(Exception);
ENodeError = class(Exception);
EInternalError = class(Exception);
 
resourcestring
lng_cap_new = 'Neue Datei anlegen';
lng_cap_rename = 'Umbennen';
lng_jnl_renamed = 'Umbenannt: "%s" zu "%s".';
lng_already_exists = 'Fehler! Die Datei "%s" existiert bereits.';
lng_move_error = 'Fehler! Konnte nicht von "%s" nach "%s" verschieben.';
lng_jnl_delete = 'LÖSCHE %s';
lng_content_was = 'Der Inhalt war:';
lng_no_content = 'Die Datei war leer.';
lng_jnl_open_external = 'Öffne mit externem Programm: %s';
lng_jnl_created = 'Erstellt: %s';
lng_jnl_stroke_from = 'Streiche von %s:';
lng_jnl_add_to = 'Füge hinzu: %s';
lng_jnl_textchange = 'Textinhalt geändert: %s';
lng_filenotfound = 'Datei wurde nicht gefunden.';
lng_editor_title = '%s - Streichlisteneditor';
lng_texteditor_title = '%s - AUTOSAVE Texteditor';
lng_stroker_really = 'Möchten Sie diese %d Zeilen wirklich streichen?';
lng_refresh_strokes_loss = 'Warnung: Beim Neu-Laden werden alle Streich-Vormerkungen (%d) entfernt. Wirklich neu laden?';
lng_appendfirst = 'Neue Zeile vor dem Schließen in "%s" ablegen?';
lng_savefirst = 'Die Änderungen an "%s" abspeichern?';
lng_strokefirst = '%d markierte Zeilen in "%s" vor dem Schließen streichen?';
lng_notdeleted = 'Fehler: Datei konnte nicht gelöscht werden!';
lng_error = 'Ein Fehler ist aufgetreten.';
lng_journal_error = 'Es konnte nicht in das Journal geschrieben werden!';
lng_deletethis = 'Datensatz "%s" wirklich löschen?';
lng_notcreated = 'Fehler: Datei konnte nicht erstellt werden!';
lng_alreadyexists_open = 'Die Datei existiert bereits. Sie wird nun geöffnet.';
lng_stroke_mismatch = 'Die zu streichende Zeile stimmt nicht mit der angezeigten Fassung überein.';
lng_stroke_error = 'Unbekannter Fehler beim Streichen.';
lng_root = 'Datensätze';
lng_text = 'Text';
lng_appender = 'Streichliste';
 
const
app_pfx = 'app_';
txt_pfx = 'tex_';
c_length_of_pfx = Length(app_pfx); // = Length(txt_pfx)
II_APPENDER = 0;
II_TEXT = 1;
II_FOLDER = 2;
II_FOREIGN = 3;
II_ROOT = 4;
FOLDER_VIEWER = 'Explorer';
 
// Konfiguration
const
CfgExpandNodesAtBeginning = false;
CfgOpenCatWhenEverythingClosed = false;
CfgAppenderAllowEmptyLines = true;
 
implementation
 
uses
categories, journal, name, appender, texteditor;
 
resourcestring
lng_internal_prefix_length_error = 'Entwicklungstechnischer Fehler! Präfixe dürfen nicht unterschiedlich lang sein!';
lng_internal_unknown_node_type_error = 'Programminterner Fehler! Node-Typ unbekannt!';
 
function GetModeFromNode(ANode: TTreeNode): TAMode; forward;
function getFileName(mode: TAMode; folder, name: string): string; forward;
function ExtractFileNameWithoutExt(fil: string): string; forward;
function getRawFileName(folder, name: string): string; forward;
function Quote(arg: string): string; forward;
 
function allFiles(folder: string): string;
begin
result := getRawFilename(folder, '*');
end;
 
function ExtractFileNameWithoutExt(fil: string): string;
begin
result := Copy(ExtractFileName(fil), 1, Length(ExtractFileName(fil))-Length(ExtractFileExt(fil)));
end;
 
function FilenameToCatname(fil: string): string;
begin
result := ExtractFileNameWithoutExt(fil);
result := Copy(result, 1+c_length_of_pfx, length(result)-c_length_of_pfx);
result := ExtractFilePath(fil) + result;
end;
 
procedure StrokeFromFile(filename: string; index: integer; expected_text: string);
var
str: TStrings;
begin
str := TStringList.Create;
try
try
str.LoadFromFile(filename);
if str.Strings[index] = expected_text then
str.Delete(index)
else
raise EStrokeMismatch.Create(lng_stroke_mismatch);
str.SaveToFile(filename);
except
on E: EStrokeMismatch do
raise
else
raise EStrokeUnknown.Create(lng_stroke_error);
end;
finally
str.Free;
end;
end;
 
procedure AddToJournal(text: string);
var
f: TextFile;
l: string;
i: integer;
begin
l := Format('[%s] %s', [DateTimeToStr(Now()), text]);
 
try
AssignFile(f, getJournalFileName());
try
if FileExists(getJournalFileName()) then
Append(f)
else
ReWrite(f);
WriteLn(f, l);
finally
CloseFile(f);
end;
except
ShowMessage(lng_journal_error);
end;
 
// Andere Forms benachrichtigen
 
for i := Screen.FormCount - 1 downto 0 do
begin
if Screen.Forms[i] is TMDIJournalForm then
begin
TMDIJournalForm(Screen.Forms[i]).DoRefresh;
break;
end
end;
end;
 
function RemoveForbiddenChars(fn: string; dir: boolean): string;
begin
result := fn;
fn := StringReplace(fn, '<', '_', [rfReplaceAll]);
fn := StringReplace(fn, '>', '_', [rfReplaceAll]);
fn := StringReplace(fn, '|', '_', [rfReplaceAll]);
fn := StringReplace(fn, '"', '_', [rfReplaceAll]);
fn := StringReplace(fn, '?', '_', [rfReplaceAll]);
fn := StringReplace(fn, ':', '_', [rfReplaceAll]);
fn := StringReplace(fn, '/', '_', [rfReplaceAll]);
if not dir then fn := StringReplace(fn, '\', '_', [rfReplaceAll]);
fn := StringReplace(fn, '*', '_', [rfReplaceAll]);
end;
 
procedure JournalDeleteEntry(fn: string);
var
dump: TStringList;
i: integer;
begin
if not fileexists(fn) then exit;
 
AddToJournal(Format(lng_jnl_delete, [GetUserFriendlyElementName(fn)]));
 
dump := TStringList.Create;
try
dump.LoadFromFile(fn);
 
if dump.Count > 0 then
begin
AddToJournal(lng_content_was);
for i := 0 to dump.Count - 1 do
begin
AddToJournal('- ' + dump.Strings[i]);
end;
end
else
begin
AddToJournal(lng_no_content);
end;
finally
dump.Free;
end;
end;
 
function commonDelete(fn: string): boolean;
var
userResponse: integer;
begin
result := false;
 
userResponse := MessageDlg(Format(lng_deletethis, [GetRelativeFileName(fn)]),
mtConfirmation, mbYesNoCancel, 0);
 
if userResponse = idYes then
begin
JournalDeleteEntry(fn);
 
if fileexists(fn) then
begin
DeleteFile(PChar(fn));
end
else if directoryexists(fn) then
begin
DelTree(fn);
end;
 
if FileExists(fn) or DirectoryExists(fn) then
begin
ShowMessage(lng_notdeleted);
Exit;
end;
 
result := true;
end;
end;
 
function GetUserFriendlyElementName(fn: string): string;
begin
result := GetRelativeFileName(fn); // TODO: Benutzer soll was anderes sehen als die Dateinamenserweiterungen
end;
 
procedure commonExternalOpen(fn: string);
begin
AddToJournal(Format(lng_jnl_open_external, [GetUserFriendlyElementName(fn)]));
 
if FileExists(fn) then
begin
ShellExecute(Application.Handle, 'open', PChar(fn), '',
PChar(Quote(fn)), SW_NORMAL);
end
else if DirectoryExists(fn) then
begin
ShellExecute(Application.Handle, 'open', FOLDER_VIEWER,
PChar(Quote(fn)), '', SW_NORMAL);
end
else
begin
ShowMessage(lng_filenotfound);
end;
end;
 
procedure openCategoriesWindow();
var
i: integer;
somethingfound: boolean;
begin
somethingfound := false;
 
for i := Screen.FormCount - 1 downto 0 do
begin
if Screen.Forms[i] is TMDICategories then
begin
TMDICategories(Screen.Forms[i]).RefreshList;
Screen.Forms[i].BringToFront;
Screen.Forms[i].WindowState := wsNormal;
somethingfound := true;
break;
end
end;
 
if not somethingfound then
begin
TMDICategories.Create(Application);
end;
end;
 
procedure newDialog(folder: string);
var
f: TextFile;
realfolder, new_folder, new_cat: string;
i: integer;
new_fn: string;
em: TAMode;
beschreibung: string;
begin
NameDlg.Caption := lng_cap_new;
NameDlg.NameEdt.Text := '';
NameDlg.Textmode.Checked := false;
NameDlg.Textmode.Enabled := true;
 
if NameDlg.ShowModal = mrOk then
begin
new_cat := ExtractFileName(namedlg.NameEdt.Text);
new_cat := RemoveForbiddenChars(new_cat, false);
 
folder := MyAddTrailingPathDelimiter(folder);
 
new_folder := ExtractFilePath(namedlg.NameEdt.Text);
new_folder := RemoveForbiddenChars(folder + new_folder, true);
 
if NameDlg.Textmode.Checked then
begin
new_fn := getTextFileName(new_folder, new_cat);
em := emText;
beschreibung := lng_text;
end
else
begin
new_fn := getAppenderFileName(new_folder, new_cat);
em := emAppender;
beschreibung := lng_appender;
end;
 
new_fn := RemoveForbiddenChars(new_fn, false);
 
realfolder := ExtractFilePath(new_fn);
ForceDirectories(realfolder);
 
if FileExists(new_fn) then
begin
ShowMessage(lng_alreadyexists_open);
if em = emText then
OpenTextEditor(new_folder, new_cat)
else
OpenAppenderEditor(new_folder, new_cat);
Exit;
end;
 
AssignFile(f, new_fn);
ReWrite(f);
CloseFile(f);
 
if not FileExists(new_fn) then
begin
ShowMessage(lng_notcreated);
Exit;
end;
 
AddToJournal(Format(lng_jnl_created, [GetUserFriendlyElementName(new_fn)]));
 
for i := Screen.FormCount - 1 downto 0 do
begin
if Screen.Forms[i] is TMDICategories then
begin
// TMDICategories(Screen.Forms[i]).RefreshList;
 
TMDICategories(Screen.Forms[i]).InsertNode(new_folder, new_cat, em);
end
end;
 
if em = emText then
OpenTextEditor(new_folder, new_cat)
else
OpenAppenderEditor(new_folder, new_cat);
end;
end;
 
procedure OpenTextEditor(folder, cat: string);
var
somethingfound: boolean;
i: integer;
begin
somethingfound := false;
 
for i := Screen.FormCount - 1 downto 0 do
begin
if Screen.Forms[i] is TMDITextEditor then
begin
if (TMDITextEditor(Screen.Forms[i]).cat = cat) and
(TMDITextEditor(Screen.Forms[i]).folder = folder) then
begin
Screen.Forms[i].BringToFront;
Screen.Forms[i].WindowState := wsNormal;
somethingfound := true;
break;
end;
end
end;
 
if not somethingfound then
begin
TMDITextEditor.Create(Application, folder, cat);
end;
end;
 
procedure OpenAppenderEditor(folder, cat: string);
var
somethingfound: boolean;
i: integer;
begin
somethingfound := false;
 
for i := Screen.FormCount - 1 downto 0 do
begin
if Screen.Forms[i] is TMDIAppender then
begin
if (TMDIAppender(Screen.Forms[i]).cat = cat) and
(TMDIAppender(Screen.Forms[i]).folder = folder) then
begin
Screen.Forms[i].BringToFront;
Screen.Forms[i].WindowState := wsNormal;
somethingfound := true;
break;
end;
end
end;
 
if not somethingfound then
begin
TMDIAppender.Create(Application, folder, cat);
end;
end;
 
function GetModeFromNode(ANode: TTreeNode): TAMode;
begin
result := emUnknown;
 
if IsAppenderNode(ANode) then
begin
result := emAppender;
end
else if IsTextNode(ANode) then
begin
result := emText;
end
else if IsFolderNode(ANode) then
begin
result := emFolder;
end else if IsForeignNode(ANode) then
begin
result := emForeign;
end;
 
if result = emUnknown then
begin
raise ENodeError.Create(lng_internal_unknown_node_type_error);
end;
end;
 
function getFileName(mode: TAMode; folder, name: string): string;
begin
if (mode = emFolder) or (mode = emForeign) then
begin
result := getFolderName(folder, name);
result := RemoveForbiddenChars(result, true);
end
else if mode = emText then
begin
result := getTextFileName(folder, name);
result := RemoveForbiddenChars(result, false);
end
else if mode = emAppender then
begin
result := getAppenderFileName(folder, name);
result := RemoveForbiddenChars(result, false);
end
else
begin
raise ENodeError.Create(lng_internal_unknown_node_type_error);
end;
end;
 
procedure renameDialog(Node: TTreeNode);
var
realfolder, new_cat, new_folder: string;
i: integer;
tofile, fromfile: string;
old_folder, old_cat: string;
old_em, new_em: TAMode;
const
folder = ''; // Wir gehen beim Umbenennen von der Wurzel aus
begin
old_em := GetModeFromNode(Node);
old_folder := GetFolderFromNode(Node);
old_cat := GetCatFromNode(Node);
 
NameDlg.Caption := lng_cap_rename;
NameDlg.NameEdt.Text := old_folder + old_cat;
NameDlg.Textmode.Checked := IsTextNode(Node);
NameDlg.Textmode.Enabled := not IsFolderNode(Node) and not IsForeignNode(Node);
 
if NameDlg.ShowModal = mrOk then
begin
if IsFolderNode(Node) or IsForeignNode(Node) then
begin
new_em := old_em;
end
else
begin
if NameDlg.Textmode.Checked then
new_em := emText
else
new_em := emAppender;
end;
 
new_cat := ExtractFileName(namedlg.NameEdt.Text);
new_cat := RemoveForbiddenChars(new_cat, false);
 
// folder := MyAddTrailingPathDelimiter(folder);
 
new_folder := ExtractFilePath(namedlg.NameEdt.Text);
new_folder := RemoveForbiddenChars(folder + new_folder, true);
 
realfolder := ExtractFilePath(getFileName(old_em, new_folder, new_cat));
if not IsFolderNode(Node) then ForceDirectories(realfolder);
 
// Enthält RemoveForbiddenChars()
fromfile := getFileName(old_em, old_folder, old_cat);
tofile := getFileName(new_em, new_folder, new_cat);
 
if fromfile = tofile then exit;
 
if fileExists(tofile) then
begin
ShowMessageFmt(lng_already_exists, [GetUserFriendlyElementName(tofile)]);
Exit;
end;
 
if not moveFile(pchar(fromfile), pchar(tofile)) then
begin
ShowMessageFmt(lng_move_error, [GetUserFriendlyElementName(fromfile), GetUserFriendlyElementName(tofile)]);
Exit;
end;
 
AddToJournal(Format(lng_jnl_renamed, [GetUserFriendlyElementName(fromfile), GetUserFriendlyElementName(tofile)]));
 
for i := Screen.FormCount - 1 downto 0 do
begin
if Screen.Forms[i] is TMDICategories then
begin
// TMDICategories(Screen.Forms[i]).RefreshList;
 
TMDICategories(Screen.Forms[i]).DeleteNode(old_folder, old_cat);
TMDICategories(Screen.Forms[i]).InsertNode(new_folder, new_cat, new_em);
end
end;
 
Node.Selected := true;
end;
end;
 
// http://delphi.about.com/cs/adptips1999/a/bltip1199_2.htm
// Modifiziert
Function DelTree(DirName : string): Boolean;
var
SHFileOpStruct : TSHFileOpStruct;
DirBuf : array [0..MAX_PATH] of char;
begin
// Backslash am Ende entfernen
if Copy(DirName, length(DirName), 1) = PathDelim then
DirName := Copy(DirName, 1, Length(DirName)-1);
 
try
Fillchar(SHFileOpStruct, SizeOf(SHFileOpStruct), 0);
FillChar(DirBuf, SizeOf(DirBuf), 0);
StrPCopy(DirBuf, DirName);
with SHFileOpStruct do
begin
Wnd := 0;
pFrom := @DirBuf;
wFunc := FO_DELETE;
fFlags := FOF_ALLOWUNDO;
fFlags := fFlags or FOF_NOCONFIRMATION;
fFlags := fFlags or FOF_SILENT;
end;
Result := (SHFileOperation(SHFileOpStruct) = 0);
except
Result := False;
end;
end;
 
function MyAddTrailingPathDelimiter(folder: string): string;
begin
result := folder;
 
if folder = '' then exit;
 
result := IncludeTrailingPathDelimiter(folder);
 
//if Copy(folder, length(folder), 1) <> PathDelim then
// result := result + PathDelim;
end;
 
function getDataPath(): string;
const
DataDirName = 'StackMan-Data';
begin
if directoryExists(DataDirName) then
result := DataDirName + PathDelim
else
result := GetPersonalFolder() + DataDirName + PathDelim;
end;
 
function getJournalFileName(): string;
const
JournalFile = 'Journal.txt';
begin
result := getDataPath() + JournalFile;
end;
 
function getRawFileName(folder, name: string): string;
begin
Folder := MyAddTrailingPathDelimiter(folder);
result := getDataPath() + Folder + name;
end;
 
function getAppenderFileName(Folder, Name: string): string;
begin
result := getRawFileName(folder, app_pfx + Name + '.txt');
end;
 
function getTextFileName(Folder, Name: string): string;
begin
result := getRawFileName(folder, txt_pfx + Name + '.txt');
end;
 
function getFolderName(Folder, Name: string): string;
begin
result := getRawFileName(folder, Name);
end;
 
function GetRelativeFileName(Filename: string): string;
var
datadir: string;
begin
result := filename;
datadir := getDataPath();
 
if LowerCase(copy(result, 1, length(datadir))) = LowerCase(datadir) then
begin
result := copy(result, 1+length(datadir), length(result)-length(datadir));
end;
end;
 
function GetRelativeNameFromNode(Node: TTreeNode): string;
begin
result := getFilenameFromNode(Node);
result := GetRelativeFileName(result);
// result := FilenameToCatname(result);
end;
 
function IsTextNode(Node: TTreeNode): boolean;
begin
result := Node.ImageIndex = II_TEXT;
end;
 
function IsFolderNode(Node: TTreeNode): boolean;
begin
result := Node.ImageIndex = II_FOLDER;
end;
 
function IsAppenderNode(Node: TTreeNode): boolean;
begin
result := Node.ImageIndex = II_APPENDER;
end;
 
function IsForeignNode(Node: TTreeNode): boolean;
begin
result := Node.ImageIndex = II_FOREIGN;
end;
 
function IsRootNode(Node: TTreeNode): boolean;
begin
result := Node.ImageIndex = II_ROOT;
end;
 
function GetFileNameFromNode(Node: TTreeNode): string;
var
folder: string;
begin
folder := GetFolderFromNode(Node);
 
if IsTextNode(Node) then
begin
result := GetTextFileName(folder, GetCatFromNode(Node));
end
else if IsAppenderNode(Node) then
begin
result := GetAppenderFileName(folder, GetCatFromNode(Node));
end
else if IsForeignNode(Node) then
begin
result := GetRawFileName(folder, GetCatFromNode(Node));
end
else if isRootNode(Node) then
begin
result := getDataPath();
end
else if IsFolderNode(Node) then
begin
result := GetRawFileName(folder, '');
end
else
begin
raise ENodeError.Create(lng_internal_unknown_node_type_error);
end;
end;
 
function GetFolderFromNode(Node: TTreeNode): string;
var
par: TTreeNode;
begin
if isRootNode(node) then exit;
if isFolderNode(node) then
par := node
else
par := node.Parent;
while not isRootNode(par) do
begin
result := par.Text + PathDelim + result;
par := par.Parent;
end;
end;
 
function Quote(arg: string): string;
begin
result := '"' + arg + '"';
end;
 
(* function GetPersonalFolder: string;
var
path : array [0..MAX_PATH] of char;
begin
SHGetSpecialFolderPath(0, @path, CSIDL_PERSONAL, false);
if path = '' then
result := ExtractFilePath(Application.ExeName)
else
result := IncludeTrailingPathDelimiter(path);
end; *)
 
function GetPersonalFolder(DefaultPath: string): string; overload;
// This function replaces SHGetSpecialFolderPath from ShlObj.pas .
// It dynamically loads the DLL, so that also Windows 95 without
// Internet Explorer 4 Extension can work with it.
type
TSHGetSpecialFolderPath = function(hwndOwner: HWND; lpszPath: PChar;
nFolder: Integer; fCreate: BOOL): BOOL; stdcall;
procedure Fail;
begin
if DefaultPath = '' then
result := ExtractFilePath(ParamStr(0))
else
result := IncludeTrailingPathDelimiter(DefaultPath);
end;
 
const
{$IFDEF MSWINDOWS}
shell32 = 'shell32.dll';
{$ENDIF}
{$IFDEF LINUX}
shell32 = 'libshell32.borland.so';
{$ENDIF}
CSIDL_PERSONAL = $0005;
var
SpecialFolder: TSHGetSpecialFolderPath;
Handle: THandle;
path: array [0..MAX_PATH] of char;
begin
result := '';
Handle := LoadLibrary(shell32);
if Handle <> 0 then
begin
{$IFDEF UNICODE}
@SpecialFolder := GetProcAddress(Handle, 'SHGetSpecialFolderPathW');
{$ELSE}
@SpecialFolder := GetProcAddress(Handle, 'SHGetSpecialFolderPathA');
{$ENDIF}
if @SpecialFolder <> nil then
begin
FillChar(path, sizeof(path), 0);
if SpecialFolder(0, @path, CSIDL_PERSONAL, false) and (path <> '') then
begin
result := IncludeTrailingPathDelimiter(path)
end
else
begin
Fail;
end;
end
else
begin
Fail;
end;
FreeLibrary(Handle);
end
else
begin
Fail;
end;
end;
 
function GetPersonalFolder(): string;
begin
result := GetPersonalFolder('C:\');
end;
 
function GetCatFromNode(Node: TTreeNode): string;
begin
if IsFolderNode(Node) then
result := ''
else
result := Node.Text;
end;
 
// http://www.delphipraxis.net/post43515.html
Function GetHTML(AUrl: string): string;
var
databuffer : array[0..4095] of char;
ResStr : string;
hSession, hfile: hInternet;
dwindex,dwcodelen,dwread,dwNumber: cardinal;
dwcode : array[1..20] of char;
res : pchar;
Str : pchar;
begin
ResStr:='';
if system.pos('http://',lowercase(AUrl))=0 then
AUrl:='http://'+AUrl;
 
// Hinzugefügt
application.ProcessMessages;
 
hSession:=InternetOpen('InetURL:/1.0',
INTERNET_OPEN_TYPE_PRECONFIG,
nil,
nil,
0);
if assigned(hsession) then
begin
// Hinzugefügt
application.ProcessMessages;
 
hfile:=InternetOpenUrl(
hsession,
pchar(AUrl),
nil,
0,
INTERNET_FLAG_RELOAD,
0);
dwIndex := 0;
dwCodeLen := 10;
 
// Hinzugefügt
application.ProcessMessages;
 
HttpQueryInfo(hfile,
HTTP_QUERY_STATUS_CODE,
@dwcode,
dwcodeLen,
dwIndex);
res := pchar(@dwcode);
dwNumber := sizeof(databuffer)-1;
if (res ='200') or (res ='302') then
begin
while (InternetReadfile(hfile,
@databuffer,
dwNumber,
DwRead)) do
begin
 
// Hinzugefügt
application.ProcessMessages;
 
if dwRead =0 then
break;
databuffer[dwread]:=#0;
Str := pchar(@databuffer);
resStr := resStr + Str;
end;
end
else
ResStr := 'Status:'+res;
if assigned(hfile) then
InternetCloseHandle(hfile);
end;
 
// Hinzugefügt
application.ProcessMessages;
 
InternetCloseHandle(hsession);
Result := resStr;
end;
 
procedure explode(delim: char; s: string; sl: TStringList);
var
i: integer;
tmp: string;
begin
tmp := '';
for i := 1 to length(s) do
begin
if s[i] = delim then
begin
sl.Add(tmp);
tmp := '';
end
else
tmp := tmp + s[i];
end;
sl.Add(tmp);
end;
 
begin
if Length(app_pfx) <> Length(txt_pfx) then
begin
raise EInternalError.Create(lng_internal_prefix_length_error);
Halt;
end;
end.