Skip to content

Commit

Permalink
NumberFormatException fix, decimal separator
Browse files Browse the repository at this point in the history 
delphi eventlist
  • Loading branch information
@jindrapetrik
jindrapetrik committed Oct 6, 2014
1 parent 3639844 commit 7629fbb
Show file tree
Hide file tree
Showing 6 changed files with 222 additions and 120 deletions.
6 changes: 3 additions & 3 deletions build.xml
View file
Original file line number Diff line number Diff line change
@@ -1,13 +1,13 @@
<?xml version="1.0" encoding="UTF-8"?>
<project name="JavactiveX" default="default" basedir=".">
<description>Builds, tests, and runs the project JavactiveX.</description>

<import file="nbproject/build-impl.xml"/>

<target name="run" depends="jar">
<java jar="${dist.jar}" fork="true">
<arg line="${application.args}" />
</java>
</target>
</target>
<import file="nbproject/build-impl.xml"/>


</project>
2 changes: 1 addition & 1 deletion libsrc/ActiveXServer/ActiveXServer.bdsproj
View file
Original file line number Diff line number Diff line change
Expand Up @@ -119,7 +119,7 @@
<Linker Name="ExeDescription"></Linker>
</Linker>
<Directories>
<Directories Name="OutputDir">..\..\lib</Directories>
<Directories Name="OutputDir">..\..\src\com\jpexs\javactivex\server</Directories>
<Directories Name="UnitOutputDir"></Directories>
<Directories Name="PackageDLLOutputDir"></Directories>
<Directories Name="PackageDCPOutputDir"></Directories>
Expand Down
3 changes: 2 additions & 1 deletion libsrc/ActiveXServer/ActiveXServer.dpr
View file
Original file line number Diff line number Diff line change
Expand Up @@ -7,7 +7,8 @@ uses
TypeLibViewer in 'TypeLibViewer.pas',
Windows,
dialogs,
RegAxCtrlList in 'RegAxCtrlList.pas';
RegAxCtrlList in 'RegAxCtrlList.pas',
UThreadStringList in 'UThreadStringList.pas';

{$R *.res}

Expand Down
159 changes: 130 additions & 29 deletions libsrc/ActiveXServer/uMain.pas
View file
Original file line number Diff line number Diff line change
Expand Up @@ -6,6 +6,10 @@ interface
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs,ActiveXHost, ExtCtrls, TypeLibViewer,Registry, RegAxCtrlList;

const
MAX_EVENT_COUNT = 1000;
dolog = false;

type
TfrmMain = class(TForm)
tmrWatchDog: TTimer;
Expand Down Expand Up @@ -41,6 +45,23 @@ TAEvent = class
EventParamTypes : array of Variant;
EventParamTypesStr : array of Variant;
EventParamNames : array of Variant;
destructor Destroy; override;
end;

TEventList = class
private
start:integer;
FLock: TRTLCriticalSection;
_count:integer;
_events:array[0..MAX_EVENT_COUNT-1] of TAEvent;
function GetCount():integer;
public
constructor Create();
destructor Destroy();override;
procedure Add(e:TAEvent);
function Pop():TAEvent;
property Count:Integer read GetCount;

end;

TPipeThread = class(TThread)
Expand Down Expand Up @@ -69,7 +90,7 @@ TPipeThread = class(TThread)
procedure WriteUI8(val:byte);
procedure WriteUI16(val:word);
procedure WriteUI32(val:cardinal);
procedure WriteString(val:string);
procedure WriteString(val:widestring);
procedure WriteParameter(val:TParameter);
procedure WriteStrings(val:TStrings);
procedure CheckCid();
Expand All @@ -95,7 +116,6 @@ TPipeThread = class(TThread)
EventParamNames : array of Variant);

public
var events:TStrings;

end;
TBuf = array[0..255] of byte;
Expand All @@ -105,6 +125,8 @@ TPipeThread = class(TThread)
var
frmMain: TfrmMain;
t: TPipeThread;
events:TEventList;
logfile:TextFile;


implementation
Expand All @@ -113,6 +135,26 @@ implementation



function myvartostr(v:Variant):widestring;
begin
DecimalSeparator:='.';
case VarType(v) of
varDouble,varSingle,varCurrency: Result:=FloatToStr(v);
varDispatch,varUnknown: Result:='-';
else Result:=v;
end;
end;

procedure log(s:string);
begin
if not dolog then
exit;
WriteLn(logfile, s);
Flush(logfile);
end;



procedure TPipeThread.CancelWatchDog;
begin
frmMain.tmrWatchDog.Enabled := False;
Expand Down Expand Up @@ -236,7 +278,7 @@ procedure TPipeThread.WriteUI32(val:cardinal);
end;


procedure TPipeThread.WriteString(val: string);
procedure TPipeThread.WriteString(val: widestring);
var a:TBuf;
len:integer;
s: UTF8String;
Expand All @@ -258,8 +300,17 @@ procedure TPipeThread.WriteStrings(val: TStrings);
end;
end;




procedure TfrmMain.StartThread();
begin
if dolog then
begin
AssignFile(logfile, 'log.txt');
ReWrite(logfile);
end;
events:=TEventList.Create;
t := TPipeThread.Create(True);
t.Resume;
end;
Expand Down Expand Up @@ -349,7 +400,7 @@ procedure TPipeThread.CreateControl();
hosts[val].progId := '';
if FRegistry.OpenKey('\CLSID\' + self.newguid + '\ProgID', False) then
begin
hosts[val].progId := FRegistry.ReadString('');
hosts[val].progId := Widestring(FRegistry.ReadString(''));
end;
WriteString(hosts[val].guid);
WriteString(hosts[val].progId);
Expand Down Expand Up @@ -538,30 +589,34 @@ procedure TPipeThread.WriteEvents;
if cnt>65535 then
cnt := 65535;
WriteUI16(cnt);
log('sending events count:'+inttostr(cnt));
for i := 0 to cnt - 1 do
begin
ev:=(events.Objects[0] as TAEvent);
ev:=events.pop();
log(inttostr(i)+') event:'+ev.EventName);
WriteUI32(ev.cid);
WriteString(ev.EventName);
WriteUI16(Length(ev.EventParams));
log(' param len:'+inttostr(Length(ev.EventParams)));
for j := 0 to Length(ev.EventParams) - 1 do
begin
log(' write param '+inttostr(j));
propVal:=ev.EventParams[j];
propTypeStr := VarTypeAsText(VarType(propVal));
if VarType(propVal) = varDispatch then
propValStr := '-'
else if VarType(propVal) = varUnknown then
propValStr := '-'
else
propValStr := VarToWideStr(propVal);
WriteString(propTypeStr);
WriteString(propValStr);
WriteString(ev.EventParamNames[j]);
WriteString(ev.EventParamTypesStr[j]);
WriteString(myvartostr(propVal));

if length(ev.EventParamNames)>j then
WriteString(ev.EventParamNames[j])
else
WriteString('Param'+inttostr(j));
if length(ev.EventParamTypesStr)>j then
WriteString(ev.EventParamTypesStr[j])
else
WriteString(propTypeStr);
end;
events.Delete(0);
ev.Free;
end;

end;


Expand Down Expand Up @@ -625,7 +680,6 @@ procedure TPipeThread.Execute();
CMD_GET_PROPERTY_TYPE = 15;

begin
events := TStringList.Create;
try
pipename := PAnsiChar('\\.\\pipe\activex_server_' + ParamStr(1));
begin
Expand Down Expand Up @@ -757,7 +811,7 @@ procedure TPipeThread.Execute();
end;

CMD_LIST_METHODS:
begin
begin
cid := ReadUI32();
Synchronize(CheckCid);
if cid<>-1 then
Expand Down Expand Up @@ -803,14 +857,8 @@ procedure TPipeThread.Execute();
begin
propVal := hosts[cid].host.PropertyValue[propName];
propTypeStr := VarTypeAsText(VarType(propVal));
if VarType(propVal) = varDispatch then
propValStr := '-'
else if VarType(propVal) = varUnknown then
propValStr := '-'
else
propValStr := VarToWideStr(propVal);
WriteString(propTypeStr);
WriteString(propValStr);
WriteString(myvartostr(propVal));
end;
end;
end;
Expand Down Expand Up @@ -873,7 +921,8 @@ procedure TPipeThread.ActiveXEvent(Sender : TObject; EventName : string;
i:integer;
begin
if Assigned(t) then
begin
begin
log('executed '+EventName);
ev:=TAEvent.Create;
ev.cid := (Sender as TComponent).Tag;
ev.EventName := EventName;
Expand All @@ -889,10 +938,62 @@ procedure TPipeThread.ActiveXEvent(Sender : TObject; EventName : string;
ev.EventParamTypesStr[i] := EventParamTypesStr[i];
for i := 0 to length(EventParamNames) - 1 do
ev.EventParamNames[i] := EventParamNames[i];

// if t.events.Count<50 then
t.events.AddObject('',ev);
events.Add(ev);
end;
end;


destructor TAEvent.Destroy;
begin

end;

constructor TEventList.Create();
begin
inherited Create;
start:=0;
_count:=0;
InitializeCriticalSection(FLock);
end;

function TEventList.Pop():TAEvent;
begin
EnterCriticalSection(FLock);
try
if _count=0 then
begin
Result:=nil;
Exit;
end;

Result := _events[start];
_events[start]:=nil;
start:=(start+1)mod MAX_EVENT_COUNT;
_count:=_count-1;
finally
LeaveCriticalSection(FLock);
end;
end;
procedure TEventList.Add(e:TAEvent);
begin
EnterCriticalSection(FLock);
_events[(start+_count)mod MAX_EVENT_COUNT]:=e;
if _count<MAX_EVENT_COUNT then
_count:=_count+1;

LeaveCriticalSection(FLock);
end;

destructor TEventList.Destroy;
begin
DeleteCriticalSection(FLock);
end;

function TEventList.GetCount():integer;
begin
EnterCriticalSection(FLock);
Result:=_count;
LeaveCriticalSection(FLock);
end;

end.
2 changes: 1 addition & 1 deletion nbproject/project.properties
View file
Original file line number Diff line number Diff line change
Expand Up @@ -29,7 +29,7 @@ dist.jar=${dist.dir}/JavactiveX.jar
dist.javadoc.dir=${dist.dir}/javadoc
endorsed.classpath=
excludes=
file.reference.jna-3.5.1.jar=lib/jna-3.5.1.jar
file.reference.jna-3.5.1.jar=lib\\jna-3.5.1.jar
includes=**
jar.compress=false
javac.classpath=\
Expand Down
Loading

0 comments on commit 7629fbb

Please sign in to comment.