Delphi: How to send MIDI to a hosted VST plugin? - delphi

I want to use VST plugins in my Delphi program which acts as a VST host. I have tried the tobybear examples, used the delphiasiovst stuf, got some of it even working, but... I don't know how to send MIDI messages to the plugin (I am aware that most plugins will not handle MIDI, but I have an example plugin that does).
To be more specific: I expect that when I send a MIDI message, I have to either use one or other method in the VST plugin or reroute the MIDI output. I just don't know how.
Can anyone point me to documentation or code on how to do this? Thanks in advance.
Arnold
I use two test plugins: the one compiled from the DelphiAsioVst package and PolyIblit. Both work in Finale and LMMS. Loaded into my test program both show their VST editor.
I did insert the TvstEvent record and initialized it, I inserted the MIDIData and the AddMIDIData procedures and a timer to provide test data and to execute the ProcessEvents routine of the plugin. ProcessEvents gets the correct test data, but no sound is heard. I hear something when I send it directly to the midi output port.
In the code below the PropcessEvents should be sufficient imho, the additional code is a test whether the MIDI information is correctly sent. VstHost [0] is the first plugin, being either the PolyIblit or the VSTPlugin, depending on the test.
procedure TMain_VST_Demo.TimerTimer (Sender: TObject);
var i: Int32;
begin
// MIDIOutput.PutShort ($90, 60, 127);
MIDIData (0, $90, 60, 127);
if FMDataCnt > 0 then
begin
FMyEvents.numEvents := FMDataCnt;
VSTHost[0].ProcessEvents(#FMyEvents);
// if (FCurrentMIDIOut > 0) and MIMidiThru.Checked then
// begin
for i := 0 to FMDataCnt - 1 do
MIDIOutput.PutShort (PVstMidiEvent (FMyEvents.events[i])^.midiData[0],
PVstMidiEvent (FMyEvents.events[i])^.midiData[1],
PVstMidiEvent (FMyEvents.events[i])^.midiData[2]);
// FMidiOutput.Send(//FCurrentMIDIOut - 1,
// PVstMidiEvent(FMyEvents.events[i])^.midiData[0],
// PVstMidiEvent(FMyEvents.events[i])^.midiData[1],
// PVstMidiEvent(FMyEvents.events[i])^.midiData[2]);
// end;
FMDataCnt := 0;
end;
end; // TimerTimer //
So I don't get the events in the plugin. Any idea what do I wrong?

You should really look at the minihost core example (Delphi ASIO project, v1.4).
There is a use of midi events. Basically
you have a TVstEvents variable ( let's say MyMidiEvents: TvstEvents).
for the whole runtime you allocate the memory for this variable ( in the app constructor for exmaple)
When you have an event in your MIDI callback, you copy it on the TVstEvents stack.
Before calling process in the TVstHost, you call MyVstHost.ProcessEvents( #MyMidiEvents ).
this is how it's done in the example (minihost core), for each previously steps:
1/ at line 215, declaration
FMyEvents: TVstEvents;
2/ at line 376, allocation:
for i := 0 to 2047 do
begin
GetMem(FMyEvents.Events[i], SizeOf(TVSTMidiEvent));
FillChar(FMyEvents.Events[i]^, SizeOf(TVSTMidiEvent), 0);
with PVstMidiEvent(FMyEvents.Events[i])^ do
begin
EventType := etMidi;
ByteSize := 24;
end;
end;
3/ at line 986 then at line 1782, the midi event is copied from the callback:
the callback
procedure TFmMiniHost.MidiData(const aDeviceIndex: Integer; const aStatus, aData1, aData2: Byte);
begin
if aStatus = $FE then exit; // ignore active sensing
if (not Player.CbOnlyChannel1.Checked) or ((aStatus and $0F) = 0) then
begin
if (aStatus and $F0) = $90
then NoteOn(aStatus, aData1, aData2) //ok
else
if (aStatus and $F0) = $80
then NoteOff(aStatus, aData1)
else AddMidiData(aStatus, aData1, aData2);
end;
end;
event copy
procedure TFmMiniHost.AddMIDIData(d1, d2, d3: byte; pos: Integer = 0);
begin
FDataSection.Acquire;
try
if FMDataCnt > 2046
then exit;
inc(FMDataCnt);
with PVstMidiEvent(FMyEvents.events[FMDataCnt - 1])^ do
begin
EventType := etMidi;
deltaFrames := pos;
midiData[0] := d1;
midiData[1] := d2;
midiData[2] := d3;
end;
finally
FDataSection.Release;
end;
end;
4/ at line 2322, in TAsioHost.Bufferswitch, the TVstHost.ProcessEvents is called
FDataSection.Acquire;
try
if FMDataCnt > 0 then
begin
FMyEvents.numEvents := FMDataCnt;
VSTHost[0].ProcessEvents(FMyEvents);
if (FCurrentMIDIOut > 0) and MIMidiThru.Checked then
begin
for i := 0 to FMDataCnt - 1 do
FMidiOutput.Send(FCurrentMIDIOut - 1,
PVstMidiEvent(FMyEvents.events[i])^.midiData[0],
PVstMidiEvent(FMyEvents.events[i])^.midiData[1],
PVstMidiEvent(FMyEvents.events[i])^.midiData[2]);
end;
FMDataCnt := 0;
end;
finally
FDataSection.Release;
end;
this should help you a lot if you were not able to analyse the method used.

If you are hosting VST 2.x plugins, you can send MIDI events to the plugin using AudioEffectX.ProcessEvents().
From the VST docs.
Events are always related to the current audio block.
For each process cycle, processEvents() is called once before a processReplacing() call (if new events are available).
I don't know of any code examples. There might be something in DelphiAsioVST.

If you're up for a change of programming language you could try VST.NET that allows you to write plugins and hosts in C# and VB.NET.
Hope it helps.

Related

Want asynchronous function execution one after the other with AsyncCalls and unable to reproduce demo

My primary goal is to run two time consuming functions or procedures one after the other has finished executing. My current approach is to place the second function invocation after the while loop (assuming I have passed one Interface type object to it in the AsyncMultiSync array param) in the code below I got from AsyncCalls Documentation.md in Github. Additionally, when I am trying to run the exact provided code below, I see that the threads do their job and the execution reaches to the first access to the vcl thread Memo but the second access to the memo freezes the application (for directories having quite a lot of files in the GetFiles call) P.S. English is not my first language and I might have trouble explaining it but if you demote this for title or MCVE, it will be my last question here as per SO rules.
uses
..AsyncCalls;
{ Ex - 2 using global function }
function GetFiles(Directory: string; Filenames: TStrings): Integer;
var
h: THandle;
FindData: TWin32FindData;
begin
h := FindFirstFile(PChar(Directory + '\*.*'), FindData);
if h <> INVALID_HANDLE_VALUE then
begin
repeat
if (StrComp(FindData.cFileName, '.') <> 0) and (StrComp(FindData.cFileName, '..') <> 0) then
begin
Filenames.Add(Directory + '\' + FindData.cFileName);
if FindData.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY <> 0 then
GetFiles(Filenames[Filenames.Count - 1], Filenames);
end;
until not FindNextFile(h, FindData);
Winapi.Windows.FindClose(h);
end;
Result := 0;
end;
procedure TForm1.ButtonGetFilesClick(Sender: TObject);
var
i: integer;
Dir1Files, Dir2Files: TStrings;
Dir1, Dir2 IAsyncCall;
begin
Dir1Files := TStringList.Create;
Dir2Files := TStringList.Create;
ButtonGetFiles.Enabled := False;
try
Dir1 := TAsyncCalls.Invoke<string, TStrings>(GetFiles, 'C:\portables\autoit-v3', Dir1Files);
Dir2 := TAsyncCalls.Invoke<string, TStrings>(GetFiles, 'E:\mySyntax-Repository-works', Dir2Files);
{ Wait until both async functions have finished their work. While waiting make the UI
reacting on user interaction. }
while AsyncMultiSync([Dir1, Dir2], True, 10) = WAIT_TIMEOUT do
Application.ProcessMessages;
{ Form1.Caption := 'after file search';}
MemoFiles.Lines.Assign(Dir1Files);
MemoFiles.Lines.AddStrings(Dir2Files); {-->causes freeze}
finally
ButtonGetFiles.Enabled := True;
Dir2Files.Free;
Dir1Files.Free;
end;
end;
One alternative solution to use is JvThread as it contains well commented demos. Multiple JvThread objects can be wired via onFinish events to start one after another. If required, that many Sync functions can be constructed to talk to the VCL thread where race risk exists(between the thread and the VCL thread). And if required, each JvThread can be force-finished i.e.'breaked' by terminating it, based on some logic, inside of the thread execution code or in the associated Sync function in the VCL thread. How is it different from using timers or threaded timers triggering each other one after another in the first place given we use quite a few global form fields? Answer is there is no onFinish equivalent for timers and it will take more effort and less elegance to achieve the same. Omnithread is somewhat restrictive for its BSD licence, Native threads beat the RAD spirit of Delphi, and Task library not available in lighter installs like XE5.

Delphi ODAC: Disecting JMS messages from Oracle AQ

I'm trying to evaluate ODAC for using Oracle AQ.
The request queue contains JMS objects like these (but without linebreaks and other whitespace):
SYS.AQ$_JMS_BYTES_MESSAGE(
SYS.AQ$_JMS_HEADER(
'null','null','null','null','null','null',
SYS.AQ$_JMS_USERPROPARRAY(
SYS.AQ$_JMS_USERPROPERTY('Key1',100,'Value1','null',27),
SYS.AQ$_JMS_USERPROPERTY('Key2',100,'Value2','null',27),
SYS.AQ$_JMS_USERPROPERTY('Key3',100,'Value3','null',27),
SYS.AQ$_JMS_USERPROPERTY('Key4',100,'Value4','null',27),
SYS.AQ$_JMS_USERPROPERTY('Key5',100,'Value5','null',27),
SYS.AQ$_JMS_USERPROPERTY('Key6',100,'Value6','null',27),
SYS.AQ$_JMS_USERPROPERTY('Key7',100,'Value7','null',27),
SYS.AQ$_JMS_USERPROPERTY('Key8',100,'Value8','null',27),
SYS.AQ$_JMS_USERPROPERTY('Key9',100,'Value9','null',27),
SYS.AQ$_JMS_USERPROPERTY('Key10',100,'Value10.0','null',27),
SYS.AQ$_JMS_USERPROPERTY('Key11',100,'Value11','null',27),
SYS.AQ$_JMS_USERPROPERTY('Key12',100,'Value12','null',27),
SYS.AQ$_JMS_USERPROPERTY('Key13',100,'Value13','null',27),
SYS.AQ$_JMS_USERPROPERTY('Key14',100,'Value14','null',27),
SYS.AQ$_JMS_USERPROPERTY('Key15',100,'Value15','null',27),
SYS.AQ$_JMS_USERPROPERTY('Key16',100,'Value16','null',27),
SYS.AQ$_JMS_USERPROPERTY('Key17',100,'Value17','null',27)
)
),
4168,'null','oracle.sql.BLOB#959acc'
)
I can receive the underlying object (a string Payload comes back as an empty string, but a TOraObject PayLoad contains data).
I'm trying to disscect the TOraObject PayLoad, and am looking for a table that converts the DataType values into the correct AttrXxxx[Name] property calls.
OraType.AttributeCount:4
OraType.Name:"SYS"."AQ$_JMS_BYTES_MESSAGE"
OraType.DataType:15
Attribute[0].Name:HEADER
Attribute[0].DataType:15
OraType.AttributeCount:7
OraType.Name:"SYS"."AQ$_JMS_HEADER"
OraType.DataType:15
Attribute[0].Name:REPLYTO
Attribute[0].DataType:15
OraType.AttributeCount:3
OraType.Name:"SYS"."AQ$_AGENT"
OraType.DataType:15
Attribute[0].Name:NAME
Attribute[0].DataType:1
Attribute[1].Name:ADDRESS
Attribute[1].DataType:1
Attribute[2].Name:PROTOCOL
Attribute[2].DataType:5
Attribute[1].Name:TYPE
Attribute[1].DataType:1
Attribute[2].Name:USERID
Attribute[2].DataType:1
Attribute[3].Name:APPID
Attribute[3].DataType:1
Attribute[4].Name:GROUPID
Attribute[4].DataType:1
Attribute[5].Name:GROUPSEQ
Attribute[5].DataType:5
Attribute[6].Name:PROPERTIES
Attribute[6].DataType:17
OraType.AttributeCount:1
OraType.Name:"SYS"."AQ$_JMS_USERPROPARRAY"
OraType.DataType:17
Attribute[0].Name:ELEMENT
Attribute[0].DataType:15
OraType.AttributeCount:5
OraType.Name:"SYS"."AQ$_JMS_USERPROPERTY"
OraType.DataType:15
Attribute[0].Name:NAME
Attribute[0].DataType:1
Attribute[1].Name:TYPE
Attribute[1].DataType:5
Attribute[2].Name:STR_VALUE
Attribute[2].DataType:1
Attribute[3].Name:NUM_VALUE
Attribute[3].DataType:5
Attribute[4].Name:JAVA_TYPE
Attribute[4].DataType:5
Attribute[1].Name:BYTES_LEN
Attribute[1].DataType:5
Attribute[2].Name:BYTES_RAW
Attribute[2].DataType:1
Attribute[3].Name:BYTES_LOB
Attribute[3].DataType:102
By trial and error, I have come so far:
case DataType of
102:
LOB := ObjectPayLoad.AttrAsLob[Name];
15:
AttributeOraObject := ObjectPayLoad.AttrAsObject[Name];
17:
AttributeOraArray := ObjectPayLoad.AttrAsArray[Name];
else
begin
PayLoadAttributeAsString := ObjectPayLoad. AttrAsString[Name];
Logger.Log(' "%s"', [PayLoadAttributeAsString]);
end;
end;
A more complete list is welcome :-)
After this, I will need to research the other way around: generating the right TOraObject that has a JMS content in it.
Tips for that are also welcome.
--jeroen
Edit:
ODAC has multiple units defining constants.
The constant dtOraBlob with value 102 is in the OraClasses unit; constants defining DataType values start with the prefix dt, regardless of the unit that defines them.
Original:
I have found a few of these constants in the MemData unit:
case DataType of
102:
LOB := OraObject.AttrAsLob[Name];
MemData.dtObject: // 15
begin
AttributeOraObject := OraObject.AttrAsObject[Name];
LogOraObject(AttributeOraObject, Level+1);
end;
MemData.dtArray: // 17
begin
AttributeOraArray := OraObject.AttrAsArray[Name];
LogOraArray(AttributeOraArray, Level);
end;
MemData.dtFloat: // 5
begin
AttributeFloat := OraObject.AttrAsFloat[Name];
Logger.Log(Prefix+'"%g"', [AttributeFloat]);
end;
MemData.dtString: // 1
begin
PayLoadAttributeAsString := OraObject.AttrAsString[Name];
Logger.Log(Prefix+'"%s"', [PayLoadAttributeAsString]);
end;
else
begin
PayLoadAttributeAsString := OraObject.AttrAsString[Name];
Logger.Log(Prefix+'"%s"', [PayLoadAttributeAsString]);
end;
end;
I can't find the 102 constant though, but I'm pretty sure it is for a LOB field.
Anyone who can confirm that?
--jeroen

Improve speed of own debug visualizer for Delphi 2010

I wrote Delphi debug visualizer for TDataSet to display values of current row, source + screenshot: http://delphi.netcode.cz/text/tdataset-debug-visualizer.aspx . Working good, but very slow. I did some optimalization (how to get fieldnames) but still for only 20 fields takes 10 seconds to show - very bad.
Main problem seems to be slow IOTAThread90.Evaluate used by main code shown below, this procedure cost most of time, line with ** about 80% time. FExpression is name of TDataset in code.
procedure TDataSetViewerFrame.mFillData;
var
iCount: Integer;
I: Integer;
// sw: TStopwatch;
s: string;
begin
// sw := TStopwatch.StartNew;
iCount := StrToIntDef(Evaluate(FExpression+'.Fields.Count'), 0);
for I := 0 to iCount - 1 do
begin
s:= s + Format('%s.Fields[%d].FieldName+'',''+', [FExpression, I]);
// FFields.Add(Evaluate(Format('%s.Fields[%d].FieldName', [FExpression, I])));
FValues.Add(Evaluate(Format('%s.Fields[%d].Value', [FExpression, I]))); //**
end;
if s<> '' then
Delete(s, length(s)-4, 5);
s := Evaluate(s);
s:= Copy(s, 2, Length(s) -2);
FFields.CommaText := s;
{ sw.Stop;
s := sw.Elapsed;
Application.MessageBox(Pchar(s), '');}
end;
Now I have no idea how to improve performance.
That Evaluate needs to do a surprising amount of work. The compiler needs to compile it, resolving symbols to memory addresses, while evaluating properties may cause functions to be called, which needs the debugger to copy the arguments across into the debugee, set up a stack frame, invoke the function to be called, collect the results - and this involves pausing and resuming the debugee.
I can only suggest trying to pack more work into the Evaluate call. I'm not 100% sure how the interaction between the debugger and the evaluator (which is part of the compiler) works for these visualizers, but batching up as much work as possible may help. Try building up a more complicated expression before calling Evaluate after the loop. You may need to use some escaping or delimiting convention to unpack the results. For example, imagine what an expression that built the list of field values and returned them as a comma separated string would look like - but you would need to escape commas in the values themselves.
Because Delphi is a different process than your debugged exe, you cannot direct use the memory pointers of your exe, so you need to use ".Evaluate" for everything.
You can use 2 different approaches:
Add special debug dump function into executable, which does all value retrieving in one call
Inject special dll into exe with does the same as 1 (more hacking etc)
I got option 1 working, 2 should also be possible but a little bit more complicated and "ugly" because of hacking tactics...
With code below (just add to dpr) you can use:
Result := 'Dump=' + Evaluate('TObjectDumper.SpecialDump(' + FExpression + ')');
Demo code of option 1, change it for your TDataset (maybe make CSV string of all values?):
unit Unit1;
interface
type
TObjectDumper = class
public
class function SpecialDump(aObj: TObject): string;
end;
implementation
class function TObjectDumper.SpecialDump(aObj: TObject): string;
begin
Result := '';
if aObj <> nil then
Result := 'Special dump: ' + aObj.Classname;
end;
initialization
//dummy call, just to ensure it is linked c.q. used by compiler
TObjectDumper.SpecialDump(nil);
end.
Edit: in case someone is interested: I got option 2 working too (bpl injection)
I have not had a chance to play with the debug visualizers yet, so I do not know if this work, but have you tried using Evaluate() to convert FExpression into its actual memory address? If you can do that, then type-cast that memory address to a TDataSet pointer and use its properties normally without going through additional Evaluate() calls. For example:
procedure TDataSetViewerFrame.mFillData;
var
DS: TDataSet;
I: Integer;
// sw: TStopwatch;
begin
// sw := TStopwatch.StartNew;
DS := TDataSet(StrToInt(Evaluate(FExpression)); // this line may need tweaking
for I := 0 to DS.Fields.Count - 1 do
begin
with DS.Fields[I] do begin
FFields.Add(FieldName);
FValues.Add(VarToStr(Value));
end;
end;
{
sw.Stop;
s := sw.Elapsed;
Application.MessageBox(Pchar(s), '');
}
end;

How can I get this File Writing code to work with Unicode (Delphi)

I had some code before I moved to Unicode and Delphi 2009 that appended some text to a log file a line at a time:
procedure AppendToLogFile(S: string);
// this function adds our log line to our shared log file
// Doing it this way allows Wordpad to open it at the same time.
var F, C1 : dword;
begin
if LogFileName <> '' then begin
F := CreateFileA(Pchar(LogFileName), GENERIC_READ or GENERIC_WRITE, 0, nil, OPEN_ALWAYS, 0, 0);
if F <> 0 then begin
SetFilePointer(F, 0, nil, FILE_END);
S := S + #13#10;
WriteFile(F, Pchar(S)^, Length(S), C1, nil);
CloseHandle(F);
end;
end;
end;
But CreateFileA and WriteFile are binary file handlers and are not appropriate for Unicode.
I need to get something to do the equivalent under Delphi 2009 and be able to handle Unicode.
The reason why I'm opening and writing and then closing the file for each line is simply so that other programs (such as WordPad) can open the file and read it while the log is being written.
I have been experimenting with TFileStream and TextWriter but there is very little documentation on them and few examples.
Specifically, I'm not sure if they're appropriate for this constant opening and closing of the file. Also I'm not sure if they can make the file available for reading while they have it opened for writing.
Does anyone know of a how I can do this in Delphi 2009 or later?
Conclusion:
Ryan's answer was the simplest and the one that led me to my solution. With his solution, you also have to write the BOM and convert the string to UTF8 (as in my comment to his answer) and then that worked just fine.
But then I went one step further and investigated TStreamWriter. That is the equivalent of the .NET function of the same name. It understands Unicode and provides very clean code.
My final code is:
procedure AppendToLogFile(S: string);
// this function adds our log line to our shared log file
// Doing it this way allows Wordpad to open it at the same time.
var F: TStreamWriter;
begin
if LogFileName <> '' then begin
F := TStreamWriter.Create(LogFileName, true, TEncoding.UTF8);
try
F.WriteLine(S);
finally
F.Free;
end;
end;
Finally, the other aspect I discovered is if you are appending a lot of lines (e.g. 1000 or more), then the appending to the file takes longer and longer and it becomes quite inefficient.
So I ended up not recreating and freeing the LogFile each time. Instead I keep it open and then it is very fast. The only thing I can't seem to do is allow viewing of the file with notepad while it is being created.
For logging purposes why use Streams at all?
Why not use TextFiles? Here is a very simple example of one of my logging routines.
procedure LogToFile(Data:string);
var
wLogFile: TextFile;
begin
AssignFile(wLogFile, 'C:\MyTextFile.Log');
{$I-}
if FileExists('C:\MyTextFile.Log') then
Append(wLogFile)
else
ReWrite(wLogFile);
WriteLn(wLogfile, S);
CloseFile(wLogFile);
{$I+}
IOResult; //Used to clear any possible remaining I/O errors
end;
I actually have a fairly extensive logging unit that uses critical sections for thread safety, can optionally be used for internal logging via the OutputDebugString command as well as logging specified sections of code through the use of sectional identifiers.
If anyone is interested I'll gladly share the code unit here.
Char and string are Wide since D2009. Thus you should use CreateFile instead of CreateFileA!
If you werite the string you shoudl use Length( s ) * sizeof( Char ) as the byte length and not only Length( s ). because of the widechar issue. If you want to write ansi chars, you should define s as AnsiString or UTF8String and use sizeof( AnsiChar ) as a multiplier.
Why are you using the Windows API function instead of TFileStream defined in classes.pas?
Try this little function I whipped up just for you.
procedure AppendToLog(filename,line:String);
var
fs:TFileStream;
ansiline:AnsiString;
amode:Integer;
begin
if not FileExists(filename) then
amode := fmCreate
else
amode := fmOpenReadWrite;
fs := TFileStream.Create(filename,{mode}amode);
try
if (amode<>fmCreate) then
fs.Seek(fs.Size,0); {go to the end, append}
ansiline := AnsiString(line)+AnsiChar(#13)+AnsiChar(#10);
fs.WriteBuffer(PAnsiChar(ansiline)^,Length(ansiline));
finally
fs.Free;
end;
Also, try this UTF8 version:
procedure AppendToLogUTF8(filename, line: UnicodeString);
var
fs: TFileStream;
preamble:TBytes;
outpututf8: RawByteString;
amode: Integer;
begin
if not FileExists(filename) then
amode := fmCreate
else
amode := fmOpenReadWrite;
fs := TFileStream.Create(filename, { mode } amode, fmShareDenyWrite);
{ sharing mode allows read during our writes }
try
{internal Char (UTF16) codepoint, to UTF8 encoding conversion:}
outpututf8 := Utf8Encode(line); // this converts UnicodeString to WideString, sadly.
if (amode = fmCreate) then
begin
preamble := TEncoding.UTF8.GetPreamble;
fs.WriteBuffer( PAnsiChar(preamble)^, Length(preamble));
end
else
begin
fs.Seek(fs.Size, 0); { go to the end, append }
end;
outpututf8 := outpututf8 + AnsiChar(#13) + AnsiChar(#10);
fs.WriteBuffer(PAnsiChar(outpututf8)^, Length(outpututf8));
finally
fs.Free;
end;
end;
If you try to use text file or Object Pascal typed/untyped files in a multithreaded application you gonna have a bad time.
No kidding - the (Object) Pascal standard file I/O uses global variables to set file mode and sharing. If your application runs in more than one thread (or fiber if anyone still use them) using standard file operations could result in access violations and unpredictable behavior.
Since one of the main purposes of logging is debugging a multithreaded application, consider using other means of file I/O: Streams and Windows API.
(And yes, I know it is not really an answer to the original question, but I do not wish to log in - therefor I do not have the reputation score to comment on Ryan J. Mills's practically wrong answer.)

How to read log-files over network real fast?

I'm using Delphi 2007 and have an application that read log-files from several places over an internal network and display exceptions. Those directories sometimes contains thousands of log-files. The application have an option to read only log-files from the n latest days bit it can also be in any datetime range.
The problem is that the first time the log directory is read it can be very slow (several minutes). The second time it is considerably faster.
I wonder how I can optimize my code to read the log-files as fast as possible ?
I'm using a vCurrentFile: TStringList to store the file in memory.
That is updated from a FileStream as I think this is faster.
Here is some code:
Refresh: The main loop to read log-files
// In this function the logfiles are searched for exceptions. If a exception is found it is stored in a object.
// The exceptions are then shown in the grid
procedure TfrmMain.Refresh;
var
FileData : TSearchRec; // Used for the file searching. Contains data of the file
vPos, i, PathIndex : Integer;
vCurrentFile: TStringList;
vDate: TDateTime;
vFileStream: TFileStream;
begin
tvMain.DataController.RecordCount := 0;
vCurrentFile := TStringList.Create;
memCallStack.Clear;
try
for PathIndex := 0 to fPathList.Count - 1 do // Loop 0. This loops until all directories are searched through
begin
if (FindFirst (fPathList[PathIndex] + '\*.log', faAnyFile, FileData) = 0) then
repeat // Loop 1. This loops while there are .log files in Folder (CurrentPath)
vDate := FileDateToDateTime(FileData.Time);
if chkLogNames.Items[PathIndex].Checked and FileDateInInterval(vDate) then
begin
tvMain.BeginUpdate; // To speed up the grid - delays the guichange until EndUpdate
fPathPlusFile := fPathList[PathIndex] + '\' + FileData.Name;
vFileStream := TFileStream.Create(fPathPlusFile, fmShareDenyNone);
vCurrentFile.LoadFromStream(vFileStream);
fUser := FindDataInRow(vCurrentFile[0], 'User'); // FindData Returns the string after 'User' until ' '
fComputer := FindDataInRow(vCurrentFile[0], 'Computer'); // FindData Returns the string after 'Computer' until ' '
Application.ProcessMessages; // Give some priority to the User Interface
if not CancelForm.IsCanceled then
begin
if rdException.Checked then
for i := 0 to vCurrentFile.Count - 1 do
begin
vPos := AnsiPos(MainExceptionToFind, vCurrentFile[i]);
if vPos > 0 then
UpdateView(vCurrentFile[i], i, MainException);
vPos := AnsiPos(ExceptionHintToFind, vCurrentFile[i]);
if vPos > 0 then
UpdateView(vCurrentFile[i], i, HintException);
end
else if rdOtherText.Checked then
for i := 0 to vCurrentFile.Count - 1 do
begin
vPos := AnsiPos(txtTextToSearch.Text, vCurrentFile[i]);
if vPos > 0 then
UpdateView(vCurrentFile[i], i, TextSearch)
end
end;
vFileStream.Destroy;
tvMain.EndUpdate; // Now the Gui can be updated
end;
until(FindNext(FileData) <> 0) or (CancelForm.IsCanceled); // End Loop 1
end; // End Loop 0
finally
FreeAndNil(vCurrentFile);
end;
end;
UpdateView method: Add one row to the displaygrid
{: Update the grid with one exception}
procedure TfrmMain.UpdateView(aLine: string; const aIndex, aType: Integer);
var
vExceptionText: String;
vDate: TDateTime;
begin
if ExceptionDateInInterval(aLine, vDate) then // Parse the date from the beginning of date
begin
if aType = MainException then
vExceptionText := 'Exception'
else if aType = HintException then
vExceptionText := 'Exception Hint'
else if aType = TextSearch then
vExceptionText := 'Text Search';
SetRow(aIndex, vDate, ExtractFilePath(fPathPlusFile), ExtractFileName(fPathPlusFile), fUser, fComputer, aLine, vExceptionText);
end;
end;
Method to decide if row is in daterange:
{: This compare exact exception time against the filters
#desc 2 cases: 1. Last n days
2. From - to range}
function TfrmMain.ExceptionDateInInterval(var aTestLine: String; out aDateTime: TDateTime): Boolean;
var
vtmpDate, vTmpTime: String;
vDate, vTime: TDateTime;
vIndex: Integer;
begin
aDateTime := 0;
vtmpDate := Copy(aTestLine, 0, 8);
vTmpTime := Copy(aTestLine, 10, 9);
Insert(DateSeparator, vtmpDate, 5);
Insert(DateSeparator, vtmpDate, 8);
if TryStrToDate(vtmpDate, vDate, fFormatSetting) and TryStrToTime(vTmpTime, vTime) then
aDateTime := vDate + vTime;
Result := (rdLatest.Checked and (aDateTime >= (Now - spnDateLast.Value))) or
(rdInterval.Checked and (aDateTime>= dtpDateFrom.Date) and (aDateTime <= dtpDateTo.Date));
if Result then
begin
vIndex := AnsiPos(']', aTestLine);
if vIndex > 0 then
Delete(aTestLine, 1, vIndex + 1);
end;
end;
Test if the filedate is inside range:
{: Returns true if the logtime is within filters range
#desc Purpose is to sort out logfiles that are no idea to parse (wrong day)}
function TfrmMain.FileDateInInterval(aFileTimeStamp: TDate): Boolean;
begin
Result := (rdLatest.Checked and (Int(aFileTimeStamp) >= Int(Now - spnDateLast.Value))) or
(rdInterval.Checked and (Int(aFileTimeStamp) >= Int(dtpDateFrom.Date)) and (Int(aFileTimeStamp) <= Int(dtpDateTo.Date)));
end;
The problem is not your logic, but the underlying file system.
Most file systems get very slow when you put many files in a directory. This is very bad with FAT, but NTFS also suffers from it, especially if you have thousands of files in a directory.
The best you can do is reorganize those directory structures, for instance by age.
Then have at most a couple of 100 files in each directory.
--jeroen
How fast do you want to be? If you want to be really fast, then you need to use something besides windows networking to read the files. The reason is if you want to read the last line of a log file (or all the lines since the last time you read it) then you need to read the whole file again.
In your question you said the problem is that it is slow to enumerate your directory listing. That is your first bottleneck. If you want to be real fast then you need to either switch to HTTP or add some sort of log server to the machine where the log files are stored.
The advantage of using HTTP is you can do a range request and just get the new lines of the log file that were added since you last requested it. That will really improve performance since you are transferring less data (especially if you enable HTTP compression) and you also have less data to process on the client side.
If you add a log server of some sort, then that server can do the processing on the server side, where it has native access to the data, and only return the rows that are in the date range. A simple way of doing that may be to just put your logs into a SQL database of some sort, and then run queries against it.
So, how fast do you want to go?

Resources