neoturk: ...Detect whether a file's volume is ntfs ?...
uses
ComObj;
function IsNTFS(AFileName: string): Boolean;
var
fso, drv: OleVariant;
begin
IsNTFS := False;
fso := CreateOleObject('Scripting.FileSystemObject');
drv := fso.GetDrive(fso.GetDriveName(AFileName));
IsNTFS := drv.FileSystem = 'NTFS'
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
if IsNTFS('X:TempFile.doc') then
ShowMessage('File is on NTFS File System')
else
ShowMessage('File is not on NTFS File System')
end;
Delphi - .....................................
neoturk: ...Detect whether a file's volume is ntfs ?...
uses
ComObj;
function IsNTFS(AFileName: string): Boolean;
var
fso, drv: OleVariant;
begin
IsNTFS := False;
fso := CreateOleObject('Scripting.FileSystemObject');
drv := fso.GetDrive(fso.GetDriveName(AFileName));
IsNTFS := drv.FileSystem = 'NTFS'
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
if IsNTFS('X:TempFile.doc') then
ShowMessage('File is on NTFS File System')
else
ShowMessage('File is not on NTFS File System')
end;
Delphi - .....................................
neoturk: ...Read a string from a text file at a certain line number ?...
{
Abstract:
Im trying to write a function that, given a FileName and a line number
returns the entire line in a string.
}
{
The following technique is useful for high-speed processing.
The sample program file, save it with a .pas or .dpr filename and compile it.
}
{$APPTYPE CONSOLE}
uses SysUtils, Classes;
function GrabLine(const AFileName: string; ALine: Integer): string;
var
fs: TFileStream;
buf: packed array[0..4095] of Char;
bufRead: Integer;
bufPos: PChar;
lineStart: PChar;
tmp: string;
begin
fs := TFileStream.Create(AFileName, fmOpenRead);
try
Dec(ALine);
bufRead := 0;
bufPos := nil;
{ read the first line specially }
if ALine = 0 then
begin
bufRead := fs.Read(buf, SizeOf(buf));
if bufRead = 0 then
raise Exception.Create('Line not found');
bufPos := buf;
end else
while ALine > 0 do
begin
{ read in a buffer }
bufRead := fs.Read(buf, SizeOf(buf));
if bufRead = 0 then
raise Exception.Create('Line not found');
bufPos := buf;
while (bufRead > 0) and (ALine > 0) do
begin
if bufPos^ = #10 then
Dec(ALine);
Inc(bufPos);
Dec(bufRead);
end;
end;
{ Found the beginning of the line at bufPos... scan for end.
2 cases:
1) we'll find it before the end of this buffer
2) it'll go beyond this buffer and into n more buffers }
lineStart := bufPos;
while (bufRead > 0) and (bufPos^ <> #10) do
begin
Inc(bufPos);
Dec(bufRead);
end;
{ if bufRead is positive, we'll have found the end and we can leave. }
SetString(Result, lineStart, bufPos - lineStart);
{ determine if there are more buffers to process }
while bufRead = 0 do
begin
bufRead := fs.Read(buf, SizeOf(buf));
lineStart := buf;
bufPos := buf;
while (bufRead > 0) and (bufPos^ <> #10) do
begin
Inc(bufPos);
Dec(bufRead);
end;
SetString(tmp, lineStart, bufPos - lineStart);
Result := Result + tmp;
end;
finally
fs.Free;
end;
end;
function GrabLine2(const s: string; ALine: Integer): string;
var
sl: TStringList;
begin
sl := TStringList.Create;
try
sl.LoadFromFile(s);
Result := sl[ALine - 1]; // index off by one
finally
sl.Free;
end;
end;
begin
Writeln(GrabLine(ParamStr(1), StrToInt(ParamStr(2))));
Writeln(GrabLine2(ParamStr(1), StrToInt(ParamStr(2))));
end.
Call it like 'getline testfile.txt 20000', depending on what you call the
.pas (or .dpr) file. For large (i.e. tens of megabytes) files, the (rather
complex) scanning function easily beats the memory expensive StringList
version.
Delphi - .....................................
neoturk: ...Read a string from a text file at a certain line number ?...
{
Abstract:
Im trying to write a function that, given a FileName and a line number
returns the entire line in a string.
}
{
The following technique is useful for high-speed processing.
The sample program file, save it with a .pas or .dpr filename and compile it.
}
{$APPTYPE CONSOLE}
uses SysUtils, Classes;
function GrabLine(const AFileName: string; ALine: Integer): string;
var
fs: TFileStream;
buf: packed array[0..4095] of Char;
bufRead: Integer;
bufPos: PChar;
lineStart: PChar;
tmp: string;
begin
fs := TFileStream.Create(AFileName, fmOpenRead);
try
Dec(ALine);
bufRead := 0;
bufPos := nil;
{ read the first line specially }
if ALine = 0 then
begin
bufRead := fs.Read(buf, SizeOf(buf));
if bufRead = 0 then
raise Exception.Create('Line not found');
bufPos := buf;
end else
while ALine > 0 do
begin
{ read in a buffer }
bufRead := fs.Read(buf, SizeOf(buf));
if bufRead = 0 then
raise Exception.Create('Line not found');
bufPos := buf;
while (bufRead > 0) and (ALine > 0) do
begin
if bufPos^ = #10 then
Dec(ALine);
Inc(bufPos);
Dec(bufRead);
end;
end;
{ Found the beginning of the line at bufPos... scan for end.
2 cases:
1) we'll find it before the end of this buffer
2) it'll go beyond this buffer and into n more buffers }
lineStart := bufPos;
while (bufRead > 0) and (bufPos^ <> #10) do
begin
Inc(bufPos);
Dec(bufRead);
end;
{ if bufRead is positive, we'll have found the end and we can leave. }
SetString(Result, lineStart, bufPos - lineStart);
{ determine if there are more buffers to process }
while bufRead = 0 do
begin
bufRead := fs.Read(buf, SizeOf(buf));
lineStart := buf;
bufPos := buf;
while (bufRead > 0) and (bufPos^ <> #10) do
begin
Inc(bufPos);
Dec(bufRead);
end;
SetString(tmp, lineStart, bufPos - lineStart);
Result := Result + tmp;
end;
finally
fs.Free;
end;
end;
function GrabLine2(const s: string; ALine: Integer): string;
var
sl: TStringList;
begin
sl := TStringList.Create;
try
sl.LoadFromFile(s);
Result := sl[ALine - 1]; // index off by one
finally
sl.Free;
end;
end;
begin
Writeln(GrabLine(ParamStr(1), StrToInt(ParamStr(2))));
Writeln(GrabLine2(ParamStr(1), StrToInt(ParamStr(2))));
end.
Call it like 'getline testfile.txt 20000', depending on what you call the
.pas (or .dpr) file. For large (i.e. tens of megabytes) files, the (rather
complex) scanning function easily beats the memory expensive StringList
version.
Delphi - .....................................
neoturk: ...Encrypt- decrypt files or strings ?...
unit EZCrypt;
{modeled by Ben Hochstrasser(bhoc@surfeu.ch) after some code snippet from borland}
interface
uses Windows, Classes;
type
TWordTriple = Array[0..2] of Word;
function FileEncrypt(InFile, OutFile: String; Key: TWordTriple): boolean;
function FileDecrypt(InFile, OutFile: String; Key: TWordTriple): boolean;
function TextEncrypt(const s: string; Key: TWordTriple): string;
function TextDecrypt(const s: string; Key: TWordTriple): string;
function MemoryEncrypt(Src: Pointer; SrcSize: Cardinal; Target: Pointer; TargetSize: Cardinal; Key: TWordTriple): boolean;
function MemoryDecrypt(Src: Pointer; SrcSize: Cardinal; Target: Pointer; TargetSize: Cardinal; Key: TWordTriple): boolean;
implementation
function MemoryEncrypt(Src: Pointer; SrcSize: Cardinal; Target: Pointer; TargetSize: Cardinal; Key: TWordTriple): boolean;
var
pIn, pOut: ^byte;
i : Cardinal;
begin
if SrcSize = TargetSize then
begin
pIn := Src;
pOut := Target;
for i := 1 to SrcSize do
begin
pOut^ := pIn^ xor (Key[2] shr 8);
Key[2] := Byte(pIn^ + Key[2]) * Key[0] + Key[1];
inc(pIn);
inc(pOut);
end;
Result := True;
end else
Result := False;
end;
function MemoryDecrypt(Src: Pointer; SrcSize: Cardinal; Target: Pointer; TargetSize: Cardinal; Key: TWordTriple): boolean;
var
pIn, pOut: ^byte;
i : Cardinal;
begin
if SrcSize = TargetSize then
begin
pIn := Src;
pOut := Target;
for i := 1 to SrcSize do
begin
pOut^ := pIn^ xor (Key[2] shr 8);
Key[2] := byte(pOut^ + Key[2]) * Key[0] + Key[1];
inc(pIn);
inc(pOut);
end;
Result := True;
end else
Result := False;
end;
function TextCrypt(const s: string; Key: TWordTriple; Encrypt: Boolean): string;
var
bOK: Boolean;
begin
SetLength(Result, Length(s));
if Encrypt then
bOK := MemoryEncrypt(PChar(s), Length(s), PChar(Result), Length(Result), Key)
else
bOK := MemoryDecrypt(PChar(s), Length(s), PChar(Result), Length(Result), Key);
if not bOK then Result := '';
end;
function FileCrypt(InFile, OutFile: String; Key: TWordTriple; Encrypt: Boolean): boolean;
var
MIn, MOut: TMemoryStream;
begin
MIn := TMemoryStream.Create;
MOut := TMemoryStream.Create;
Try
MIn.LoadFromFile(InFile);
MOut.SetSize(MIn.Size);
if Encrypt then
Result := MemoryEncrypt(MIn.Memory, MIn.Size, MOut.Memory, MOut.Size, Key)
else
Result := MemoryDecrypt(MIn.Memory, MIn.Size, MOut.Memory, MOut.Size, Key);
MOut.SaveToFile(OutFile);
finally
MOut.Free;
MIn.Free;
end;
end;
function TextEncrypt(const s: string; Key: TWordTriple): string;
begin
Result := TextCrypt(s, Key, True);
end;
function TextDecrypt(const s: string; Key: TWordTriple): string;
begin
Result := TextCrypt(s, Key, False);
end;
function FileEncrypt(InFile, OutFile: String; Key: TWordTriple): boolean;
begin
Result := FileCrypt(InFile, OutFile, Key, True);
end;
function FileDecrypt(InFile, OutFile: String; Key: TWordTriple): boolean;
begin
Result := FileCrypt(InFile, OutFile, Key, False);
end;
Delphi - .....................................
neoturk: ...Encrypt- decrypt files or strings ?...
unit EZCrypt;
{modeled by Ben Hochstrasser(bhoc@surfeu.ch) after some code snippet from borland}
interface
uses Windows, Classes;
type
TWordTriple = Array[0..2] of Word;
function FileEncrypt(InFile, OutFile: String; Key: TWordTriple): boolean;
function FileDecrypt(InFile, OutFile: String; Key: TWordTriple): boolean;
function TextEncrypt(const s: string; Key: TWordTriple): string;
function TextDecrypt(const s: string; Key: TWordTriple): string;
function MemoryEncrypt(Src: Pointer; SrcSize: Cardinal; Target: Pointer; TargetSize: Cardinal; Key: TWordTriple): boolean;
function MemoryDecrypt(Src: Pointer; SrcSize: Cardinal; Target: Pointer; TargetSize: Cardinal; Key: TWordTriple): boolean;
implementation
function MemoryEncrypt(Src: Pointer; SrcSize: Cardinal; Target: Pointer; TargetSize: Cardinal; Key: TWordTriple): boolean;
var
pIn, pOut: ^byte;
i : Cardinal;
begin
if SrcSize = TargetSize then
begin
pIn := Src;
pOut := Target;
for i := 1 to SrcSize do
begin
pOut^ := pIn^ xor (Key[2] shr 8);
Key[2] := Byte(pIn^ + Key[2]) * Key[0] + Key[1];
inc(pIn);
inc(pOut);
end;
Result := True;
end else
Result := False;
end;
function MemoryDecrypt(Src: Pointer; SrcSize: Cardinal; Target: Pointer; TargetSize: Cardinal; Key: TWordTriple): boolean;
var
pIn, pOut: ^byte;
i : Cardinal;
begin
if SrcSize = TargetSize then
begin
pIn := Src;
pOut := Target;
for i := 1 to SrcSize do
begin
pOut^ := pIn^ xor (Key[2] shr 8);
Key[2] := byte(pOut^ + Key[2]) * Key[0] + Key[1];
inc(pIn);
inc(pOut);
end;
Result := True;
end else
Result := False;
end;
function TextCrypt(const s: string; Key: TWordTriple; Encrypt: Boolean): string;
var
bOK: Boolean;
begin
SetLength(Result, Length(s));
if Encrypt then
bOK := MemoryEncrypt(PChar(s), Length(s), PChar(Result), Length(Result), Key)
else
bOK := MemoryDecrypt(PChar(s), Length(s), PChar(Result), Length(Result), Key);
if not bOK then Result := '';
end;
function FileCrypt(InFile, OutFile: String; Key: TWordTriple; Encrypt: Boolean): boolean;
var
MIn, MOut: TMemoryStream;
begin
MIn := TMemoryStream.Create;
MOut := TMemoryStream.Create;
Try
MIn.LoadFromFile(InFile);
MOut.SetSize(MIn.Size);
if Encrypt then
Result := MemoryEncrypt(MIn.Memory, MIn.Size, MOut.Memory, MOut.Size, Key)
else
Result := MemoryDecrypt(MIn.Memory, MIn.Size, MOut.Memory, MOut.Size, Key);
MOut.SaveToFile(OutFile);
finally
MOut.Free;
MIn.Free;
end;
end;
function TextEncrypt(const s: string; Key: TWordTriple): string;
begin
Result := TextCrypt(s, Key, True);
end;
function TextDecrypt(const s: string; Key: TWordTriple): string;
begin
Result := TextCrypt(s, Key, False);
end;
function FileEncrypt(InFile, OutFile: String; Key: TWordTriple): boolean;
begin
Result := FileCrypt(InFile, OutFile, Key, True);
end;
function FileDecrypt(InFile, OutFile: String; Key: TWordTriple): boolean;
begin
Result := FileCrypt(InFile, OutFile, Key, False);
end;
Delphi - .....................................
neoturk: ...Check, if a filename statement is masked ?...
{++++++++++++++++++++++ Deutsch ++++++++++++++++++++++++++++++++++++++++++++
Identifizieren einer "maskierten" Angabe vom Typ Filename.
Kann u.a. beim Anlegen einer vom User festgelegte neuen Datei nützlich sein:
=> wenn maskiert, dann nicht gültig!
+++++++++++++++++++++++ English ++++++++++++++++++++++++++++++++++++++++++++
Identify a masked file name.
You can for example check for bad user input, if the file is to be created
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
function IsMaskedFileName(aFileName: string): Boolean;
begin
// First method
Result := (StrScan(PChar(aFileName), '*') <> nil) or
(StrScan(PChar(aFileName), '?') <> nil);
// Second way
Result := ((LastDelimiter('*?', aFileName) <> 0);
end;
Delphi - .....................................
neoturk: ...Check, if a filename statement is masked ?...
{++++++++++++++++++++++ Deutsch ++++++++++++++++++++++++++++++++++++++++++++
Identifizieren einer "maskierten" Angabe vom Typ Filename.
Kann u.a. beim Anlegen einer vom User festgelegte neuen Datei nützlich sein:
=> wenn maskiert, dann nicht gültig!
+++++++++++++++++++++++ English ++++++++++++++++++++++++++++++++++++++++++++
Identify a masked file name.
You can for example check for bad user input, if the file is to be created
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
function IsMaskedFileName(aFileName: string): Boolean;
begin
// First method
Result := (StrScan(PChar(aFileName), '*') <> nil) or
(StrScan(PChar(aFileName), '?') <> nil);
// Second way
Result := ((LastDelimiter('*?', aFileName) <> 0);
end;
Delphi - .....................................
neoturk: ...Show the selectdirectory dialog with a button to create directories ?...
{....}
uses
ShlObj, ActiveX;
{....}
{
This code shows the SelectDirectory dialog with additional expansions:
- an edit box, where the user can type the path name,
- also files can appear in the list,
- a button to create new directories.
Dieser Code zeigt den SelectDirectory-Dialog mit zusätzlichen Erweiterungen:
- eine Edit-Box, wo der Benutzer den Verzeichnisnamen eingeben kann,
- auch Dateien können in der Liste angezeigt werden,
- eine Schaltfläche zum Erstellen neuer Verzeichnisse.
}
function AdvSelectDirectory(const Caption: string; const Root: WideString;
var Directory: string; EditBox: Boolean = False; ShowFiles: Boolean = False;
AllowCreateDirs: Boolean = True): Boolean;
// callback function that is called when the dialog has been initialized
//or a new directory has been selected
// Callback-Funktion, die aufgerufen wird, wenn der Dialog initialisiert oder
//ein neues Verzeichnis selektiert wurde
function SelectDirCB(Wnd: HWND; uMsg: UINT; lParam, lpData: lParam): Integer;
stdcall;
var
PathName: array[0..MAX_PATH] of Char;
begin
case uMsg of
BFFM_INITIALIZED: SendMessage(Wnd, BFFM_SETSELECTION, Ord(True), Integer(lpData));
// include the following comment into your code if you want to react on the
//event that is called when a new directory has been selected
// binde den folgenden Kommentar in deinen Code ein, wenn du auf das Ereignis
//reagieren willst, das aufgerufen wird, wenn ein neues Verzeichnis selektiert wurde
{BFFM_SELCHANGED:
begin
SHGetPathFromIDList(PItemIDList(lParam), @PathName);
// the directory "PathName" has been selected
// das Verzeichnis "PathName" wurde selektiert
end;}
end;
Result := 0;
end;
var
WindowList: Pointer;
BrowseInfo: TBrowseInfo;
Buffer: PChar;
RootItemIDList, ItemIDList: PItemIDList;
ShellMalloc: IMalloc;
IDesktopFolder: IShellFolder;
Eaten, Flags: LongWord;
const
// necessary for some of the additional expansions
// notwendig für einige der zusätzlichen Erweiterungen
BIF_USENEWUI = $0040;
BIF_NOCREATEDIRS = $0200;
begin
Result := False;
if not DirectoryExists(Directory) then
Directory := '';
FillChar(BrowseInfo, SizeOf(BrowseInfo), 0);
if (ShGetMalloc(ShellMalloc) = S_OK) and (ShellMalloc <> nil) then
begin
Buffer := ShellMalloc.Alloc(MAX_PATH);
try
RootItemIDList := nil;
if Root <> '' then
begin
SHGetDesktopFolder(IDesktopFolder);
IDesktopFolder.ParseDisplayName(Application.Handle, nil,
POleStr(Root), Eaten, RootItemIDList, Flags);
end;
OleInitialize(nil);
with BrowseInfo do
begin
hwndOwner := Application.Handle;
pidlRoot := RootItemIDList;
pszDisplayName := Buffer;
lpszTitle := PChar(Caption);
// defines how the dialog will appear:
// legt fest, wie der Dialog erscheint:
ulFlags := BIF_RETURNONLYFSDIRS or BIF_USENEWUI or
BIF_EDITBOX * Ord(EditBox) or BIF_BROWSEINCLUDEFILES * Ord(ShowFiles) or
BIF_NOCREATEDIRS * Ord(not AllowCreateDirs);
lpfn := @SelectDirCB;
if Directory <> '' then
lParam := Integer(PChar(Directory));
end;
WindowList := DisableTaskWindows(0);
try
ItemIDList := ShBrowseForFolder(BrowseInfo);
finally
EnableTaskWindows(WindowList);
end;
Result := ItemIDList <> nil;
if Result then
begin
ShGetPathFromIDList(ItemIDList, Buffer);
ShellMalloc.Free(ItemIDList);
Directory := Buffer;
end;
finally
ShellMalloc.Free(Buffer);
end;
end;
end;
// Example:
procedure TForm1.Button1Click(Sender: TObject);
var
dir: string;
begin
AdvSelectDirectory('Caption', 'c:', dir, False, False, True);
Label1.Caption := dir;
end;
Delphi - .....................................
neoturk: ...Show the selectdirectory dialog with a button to create directories ?...
{....}
uses
ShlObj, ActiveX;
{....}
{
This code shows the SelectDirectory dialog with additional expansions:
- an edit box, where the user can type the path name,
- also files can appear in the list,
- a button to create new directories.
Dieser Code zeigt den SelectDirectory-Dialog mit zusätzlichen Erweiterungen:
- eine Edit-Box, wo der Benutzer den Verzeichnisnamen eingeben kann,
- auch Dateien können in der Liste angezeigt werden,
- eine Schaltfläche zum Erstellen neuer Verzeichnisse.
}
function AdvSelectDirectory(const Caption: string; const Root: WideString;
var Directory: string; EditBox: Boolean = False; ShowFiles: Boolean = False;
AllowCreateDirs: Boolean = True): Boolean;
// callback function that is called when the dialog has been initialized
//or a new directory has been selected
// Callback-Funktion, die aufgerufen wird, wenn der Dialog initialisiert oder
//ein neues Verzeichnis selektiert wurde
function SelectDirCB(Wnd: HWND; uMsg: UINT; lParam, lpData: lParam): Integer;
stdcall;
var
PathName: array[0..MAX_PATH] of Char;
begin
case uMsg of
BFFM_INITIALIZED: SendMessage(Wnd, BFFM_SETSELECTION, Ord(True), Integer(lpData));
// include the following comment into your code if you want to react on the
//event that is called when a new directory has been selected
// binde den folgenden Kommentar in deinen Code ein, wenn du auf das Ereignis
//reagieren willst, das aufgerufen wird, wenn ein neues Verzeichnis selektiert wurde
{BFFM_SELCHANGED:
begin
SHGetPathFromIDList(PItemIDList(lParam), @PathName);
// the directory "PathName" has been selected
// das Verzeichnis "PathName" wurde selektiert
end;}
end;
Result := 0;
end;
var
WindowList: Pointer;
BrowseInfo: TBrowseInfo;
Buffer: PChar;
RootItemIDList, ItemIDList: PItemIDList;
ShellMalloc: IMalloc;
IDesktopFolder: IShellFolder;
Eaten, Flags: LongWord;
const
// necessary for some of the additional expansions
// notwendig für einige der zusätzlichen Erweiterungen
BIF_USENEWUI = $0040;
BIF_NOCREATEDIRS = $0200;
begin
Result := False;
if not DirectoryExists(Directory) then
Directory := '';
FillChar(BrowseInfo, SizeOf(BrowseInfo), 0);
if (ShGetMalloc(ShellMalloc) = S_OK) and (ShellMalloc <> nil) then
begin
Buffer := ShellMalloc.Alloc(MAX_PATH);
try
RootItemIDList := nil;
if Root <> '' then
begin
SHGetDesktopFolder(IDesktopFolder);
IDesktopFolder.ParseDisplayName(Application.Handle, nil,
POleStr(Root), Eaten, RootItemIDList, Flags);
end;
OleInitialize(nil);
with BrowseInfo do
begin
hwndOwner := Application.Handle;
pidlRoot := RootItemIDList;
pszDisplayName := Buffer;
lpszTitle := PChar(Caption);
// defines how the dialog will appear:
// legt fest, wie der Dialog erscheint:
ulFlags := BIF_RETURNONLYFSDIRS or BIF_USENEWUI or
BIF_EDITBOX * Ord(EditBox) or BIF_BROWSEINCLUDEFILES * Ord(ShowFiles) or
BIF_NOCREATEDIRS * Ord(not AllowCreateDirs);
lpfn := @SelectDirCB;
if Directory <> '' then
lParam := Integer(PChar(Directory));
end;
WindowList := DisableTaskWindows(0);
try
ItemIDList := ShBrowseForFolder(BrowseInfo);
finally
EnableTaskWindows(WindowList);
end;
Result := ItemIDList <> nil;
if Result then
begin
ShGetPathFromIDList(ItemIDList, Buffer);
ShellMalloc.Free(ItemIDList);
Directory := Buffer;
end;
finally
ShellMalloc.Free(Buffer);
end;
end;
end;
// Example:
procedure TForm1.Button1Click(Sender: TObject);
var
dir: string;
begin
AdvSelectDirectory('Caption', 'c:', dir, False, False, True);
Label1.Caption := dir;
end;
Delphi - .....................................
neoturk: ...Convert a csv file to xml ?...
> I am trying to write an application that converts a CSV(or similar)it to
> an XML one.The application looks for a character(the comma - - or anything
> else specified in an Edit box - -), adds a starting and ending tag to the
> line, and writes the line to the new XML file. in the end I should get an
> XML file with the various elements.
{Your task has a number of subtasks.
The first is parsing the input file into lines. You can leave that to a
Tstringlist, if the files you need to handle are not in the
multimegabyte size range. If they are you would be best served by using
the good old Pascal Textfile routines, where a simple ReadLn( filevar, S
) gets you a line.
The second is parsing a line into its elements, based on a separator
character between the elements. This is also not so difficult to do,
especially if you don't need to deal with quoted elements that may
contain the separator. Search the newsgroup archives for "SplitString"
for an example. Tstringlist.Delimitedtext may be of use here, but be
warned that it considers any character <= #32 as a separator *in
addition* to what you define as Delimiter. It can deal with quoted
elements, though.
The second subtask would end with a TStringlist instance containing the
elements to store into the XML file for one line of the input file. This
is the input for the third task: to create a first-level XML element
containing the data. To write valid XML you need not only deal with
proper nesting of XML tags, you also have to properly represent some
characters that have special meaning in XML ('<' and '&' for instance).
I can recommend Berend de Boers xml_generator class
http://www.pobox.com/~berend/delphi for this task, it deals with all the
nastiness behind the scenes and produces syntactically correct XML
without the overhead of a DOM model implementation.
There is something else you need: a list of column names, one name for
each "column" in your XML file. These names will become the node names
for the subnodes of the produced XML. Depending on your input files you
may be able to get these names from the first line (which often is a
header line giving the column names).
Here is sketch (untested!) of the conversion routine: }
type
{: Callback for CSVToXML. If given the callback will be called
after each processed line.
@Param currentline is the 0-based number of the processed line
@Param totallines is the total number of lines. This may be a
raw estimate if the file is not completly loaded in memory.
@Returns true to continue processing, false to stop it. }
TProgressNotification =
function(currentline, totallines: Integer): Boolean of object;
{-- CSVToXML ----------------------------------------------------------}
{: Convert a delimiter-separated file of data to XML
@Param csvfilename is the file to convert
@Param xmlfilename is the xml file to create
@Param aSeparator is the separator for the data
@Param aRootNodeName is the name to use for the root node of the XML
file.
@Param columnnames is an optional list of column names to use as subnode
names. If this parameter is nil the first line of the data file must
contain a header line with the names to use.
@Param onProgress is an optional callback to call afte each processed
line.
@Precondition csvfilename exists
}{ Created 17.3.2003 by P. Below
-----------------------------------------------------------------------}
procedure CSVToXML(const csvfilename, xmlfilename: string;
const aSeparator: Char;
const aRootNodeName: string;
const columnnames: TStrings = nil;
const onProgress: TProgressNotification = nil);
function DoProgress(currentline, totallines: Integer): Boolean;
begin
if Assigned(onProgress) then
Result := onProgress(currentline, totallines)
else
Result := true;
end;
procedure WriteDataline(const line: string; header: TStringlist; xml: TXMLGenerator);
var
elements: TStringlist;
i, max: Integer;
begin
elements := TStringlist.Create;
try
elements.Delimiter := aSeparator;
elements.Delimitedtext := line;
if elements.count > header.count then
max := header.count
else
max := elements.count;
for i := 0 to max - 1 do begin
xml.StartTag(header[i]);
xml.AddData(elements[i]);
xml.StopTag;
end; { For }
finally
elements.Free;
end;
end;
procedure WriteData(data: TStringlist; xml: TXMLGenerator);
var
header: TStringlist;
firstline: Integer;
i: Integer;
begin
header := Tstringlist.Create;
try
firstline := 0;
if assigned(columnnames) then
header.Assign(columnnames)
else begin
header.Delimiter := aSeparator;
header.DelimitedText := data[0];
firstline := 1;
end; { Else }
for i := firstline to data.count - 1 do begin
WriteDataline(data[i], header, xml);
if not DoProgress(i, data.count) then
Break;
end; { For }
finally
header.Free;
end;
end;
procedure SaveStringToFile(const S, filename: string);
var
fs: TFilestream;
begin
fs := TFileStream.Create(filename, fmCreate);
try
if Length(S) > 0 then
fs.WriteBuffer(S[1], Length(S));
finally
fs.free
end;
end; { SaveStringToFile }
var
xml: TXMLGenerator; // from xml_generator unit by Berend de Boers
datafile: Tstringlist;
begin { CSVToXML }
if not FileExists(csvfilename) then
raise Exception.CreateFmt('Input file %s not found', [csvfilename]);
datafile := Tstringlist.Create;
try
datafile.LoadfromFile(csvfilename);
xml := TXMLGenerator.CreateWithEncoding(16 * 1024, encISO_8859_1);
try
xml.StartTag(aRootNodeName);
if datafile.count > 0 then
WriteData(datafile, xml);
xml.StopTag;
SaveStringToFile(xml.AsLatin1, xmlfilename);
finally
xml.Free;
end;
finally
datafile.free;
end;
end; { CSVToXML }
