读取ini
PrintToFile:= GetPrivateProfileInt(TblName+'print','PrintToFile',0,PChar(ini));
function TStock_frm.GetIniFileInfo(Section,Key,Default:String;inifleN:String='fxsoft.ini'):String;
var
Buffer : array[0..2000] of char;
iniFile:String;
begin
//读取fuxiini
if inifleN='' then inifleN:='fxsoft.ini';
if (inifleN<>'') and (pos('\',inifleN)>0) then
if fileExists(inifleN) then iniFile:=inifleN
else iniFile := ExtractFilePath(Application.ExeName)+ExtractFileName(inifleN)
else iniFile := ExtractFilePath(Application.ExeName)+inifleN;
SetString(Result, Buffer, GetPrivateProfileString(PChar(Section),
PChar(Key), PChar(Default), Buffer, SizeOf(Buffer), PChar(iniFile)));
if Result='' then Result:=Default;
end;
//Delphi定义多维数组和读取多维数组
program Project1;
{$APPTYPE CONSOLE}
uses
SysUtils;
var
MyArr: array[0..3,0..1] of Integer = ((1,2),(4,3),(22,31),(56,10));
I1,I2: Integer;
begin
for I1 := 0 to High(MyArr) do
begin
for I2 := 0 to High(MyArr[I1]) do
begin
Writeln(MyArr[I1][I2]);
end;
end;
Readln;
end.
//delphi 动态数组的
var
arr1:array of integer
i:integer;
begin
SetLength(j,length);//设置动态数组的长度
//使用完了内存当然需要释放了,否则会造成内存泄露。动态数组使用了 reference-counting 技术,所以在使用完后,只需将其赋值为nil即可。
可以使用 读取多维数组
for i:=Low(arr1) to High(arr1) do
begin
arr1[i] :=i+1;
end;
end;
onkeypress 事件键盘
FieldStr //选中的字段名
if assigned(Grid.selectedField) then //判断是否有选中
FieldStr :=Grid.selectedField.FieldName
else
FieldStr :=Grid.Columns[Grid.SelectedIndex].FieldName //选择当前选中列的列名
//exe中载入dll 模块
Type
TDllProc =ProceDure(infor:PChar;aPrint:boolean;aHandle:HWND);
TDLLFunc =Function(infor:PChar;aPrint:boolean;aHandle:HWND):Boolean;
var
tblName,dllfleName:String;
getDataSql,s1,s2:String;
MasSQLStr,temStr:Array[0..2500] of Char;
hdll:HModule;
useADO:boolean;
DllProc:TDLLProc;
hdll :=LoadLibrary(PChar(dllfleName))
try
if hdll =0 then exit;
//获取res中的文件资源
LoadString(hdll,1000+Data.Tag,MasSQLStr,SizeOf(MasSQLStr))
if MasSQLStr ='' then
begin
if Data is TQuery then
getDataSql :=TQuery(Data).SQL.Text;
else
getDataSql :=StrPas(MasSQLStr) //数组char 转String StrPas
end;
//ADO 方式 生成xml
LoadString(hdll,9999,temStr,sizeOf(temStr))
s2 :=StrPas(temStr)
useADO :=s2<>'' and (pos('UseADO',s2)>0);
if useADO then
ADOQueryToXml(getDataSql,tblName+'.xml');
else begin
exit
end;
SaveDetailGridSizeGroupInf(tblName, DataGrid); //保存尺码信息
DllProc :=TDLLProc(GetProcAddress(hdll,PChar('print'+tblName)));//获取函数 或者过程的名
if DllProc<>nil then
begin //调用
DllProc(Pchar(infor),aPrint,Application.Handle)
end;
finally
FreeLibrary(hdll);
end;
{==============================================================================
调用定制单据打印(单个单据打印)
如果客户需要制作某个单据的定制打印(如套打之类的),则另外编写打印DLL;
首先要在fxsoft.ini中的Print单元中定义,格式为:表名=XXX.dll
如:
Sales=aile.dll
具体需要些什么数据,在DLL中定义,前面的字符串编号等于10000+TableTag确定
如销售单:
10030,select ..... from sales ....
把数据生成临时的db文件,再由dll调用、打印 }
function CustomHandlePrint(Master:TDataset;Detail:TDbGridEh;aPrint:Boolean):Boolean;
type
TDllProc = procedure(KeyID:pChar;aPrint:Boolean;aHandle:HWND);
TDllFunc = function(KeyID:pChar;aPrint:Boolean;aHandle:HWND):Boolean; //新接口,返回是否真实打印
var tblName,s1,s2,
DllfleName:String;
MasSQLStr, tmpStr,
DetSQLStr:array[0..2500]of Char;
hDll:HMODULE;
DllProc:TDllProc;
KeyID:String;
useADO:Boolean;
begin
result:=false;
tblName:=lowerCase(GetTblNameNew(Master.Tag));
DllfleName:=GetIniFileInfo('Print',PChar(tblName),'');
if DllfleName='' then exit;
hDll:=LoadLibrary(PChar(DllfleName));
try
if hDll=0 then exit;
LoadString(hDll, 10000+Master.Tag, MasSQLStr, SizeOf(MasSQLStr));
// if IntExMaster.Tag
LoadString(hDll, 10000+Detail.DataSource.DataSet.Tag, DetSQLStr, SizeOf(DetSQLStr));
if MasSQLStr='' then exit;
s1:=StrPas(MasSQLStr);
KeyID:=Master.FieldByName(tblName+'ID').AsString;
LoadString(hDll, 9999, tmpStr, SizeOf(tmpStr)); //UseADO=1;DetailFilterField=BoxNo;
s2:=StrPas(tmpStr);
useADO:=(s2<>'')and(pos('UseADO=1',s2)>0);
if useADO then
ADOQueryToXML(format(s1,[KeyID]),tblName+'.xml')
else begin
Query(DataFormA.QryTmp,Format(s1,[KeyID]),false);
TableBatchMoveTmpdb(DataFormA.QryTmp,tblName+'.db','',batCopy);
end;
s1:=StrPas(DetSQLStr);
if s1='' then //子表数据
TableBatchMoveTmpdb(TQuery(Detail.DataSource.Dataset),tblName+'Detail.db','',batCopy)
else
if useADO then
ADOQueryToXML(format(s1,[KeyID]),tblName+'Detail.xml')
else begin
Query(DataFormA.QryTmp,Format(s1,[KeyID]),false);
TableBatchMoveTmpdb(DataFormA.QryTmp,tblName+'Detail.db','',batCopy);
end;
{pSales.printsales(PChar(keyid),aPrint,Application.Handle);
result:=True;}
SaveDetailGridSizeGroupInf(tblName, Detail);
DllProc:=TDllProc(GetProcAddress(hDll,PChar('print'+tblName)));
if @DllProc<>nil then begin
DllProc(PChar(keyid),aPrint,Application.Handle);
result:=True;
end else
MBox(format('定制动态链接库"%s"中无法找到打印函数(print%s)!',[DllfleName,tblName]),MB_ICONINFORMATION);
finally
freeLibrary(hdll);
end;
end;
procedure SaveDetailGridSizeGroupInf(Const TblName:String;Grid:TDbGridEh);
var i,k:integer;
tmf1,sn1,sv1:String;
begin
tmf1:=format('%sprn%s.txt',[GetTempDirectory, TblName]);
with Grid do
for i:=0 to Columns.Count-1 do begin
if LowerCase(copy(Columns.Items[i].Field.FieldName,1,2))<>'x_' then Continue;
k:=StrToIntDef(copy(Columns.Items[i].Field.FieldName,3,2),1);
sn1:=format('尺码%d',[k]);
sv1:=Columns.Items[i].Title.Caption;
if pos(#13,sv1)>0 then
begin
if pos(#13#10,sv1)>0 then
sv1:=StringReplace(sv1,#13#10,';',[rfReplaceAll])
else
sv1:=StringReplace(sv1,#13,';',[rfReplaceAll]);
end;
WritePrivateProfileString(PChar(tblName),PChar(sn1),PChar(sv1),PChar(tmf1))
end;
end;
function TableBatchMoveTmpdb(Sou:TBDEDataSet;DestDbN,Maps:String;BathMode:TBatchMode):String;
var tbl:TTable;
bath:TBatchMove;
Tmp:String;
qry:TQuery;
begin
tbl:=TTable.Create(Nil);
tbl.DatabaseName:=DataFormA.ParadoxTmp.DatabaseName;
tbl.TableName:=DestDbN;
bath:=TBatchMove.Create(nil);
With Bath do
try
Source:=Sou;
Destination:=Tbl;
Mode:=BathMode;
AbortOnKeyViol:=false;
AbortOnProblem:=false;
if Maps<>'' then
While True do begin
if Maps='' then Break;
Tmp:=FetchSegStr(Maps,';');
if Tmp<>'' then
Mappings.Add(Tmp);
end;
try
Execute;
result:=GetTempDirectory+tbl.TableName;
//再添加当前用户名称(因为某些用户的定制打印需要传递操作员参数)
if Sou.FindField('_UserName')<>nil
then begin
qry:=TQuery.Create(nil);
try
qry.DatabaseName:=tbl.DatabaseName;
qry.SQL.Text:=format('Update "%s" set "%s"."_UserName"="%s"',[tbl.TableName,tbl.TableName,sysInfo.UserName]);
qry.ExecSQL;
finally
qry.free;
end;
end;
except
result:='';
end;
finally
tbl.free;
free;
end
end;
function ADOQueryToXML(sqlString:WideString;DestDbN:String):String;
var ADOQry:TADOQuery;
f1:String;
begin
result:='';
ADOQry:=TADOQuery.Create(Application);
f1:=GetTempDirectory+DestDbN;//copy(DestDbN,1,length(DestDbN)-3)+'xml';
with ADOQry do
try
Connection:=DataForm.FZADODB;
SQL.Text:=sqlString;
try
Open;
SaveToFile(f1, pfXML);
result:=f1;
except
raise
end;
finally
free
end;
end;
function GetTempDirectory: String;
var
TempDir: array[0..MAX_PATH] of Char;
begin
GetTempPath(255, @TempDir);
Result := StrPas(TempDir);
end;
//dll 模块中
Function GetTempData(TmpData: TmpDataSet; fle: String): Boolean;
Begin
TmpData.Close;
Try
{$IFDEF USEADO}
TmpData.LoadFromFile(fle);
{$ELSE}
TmpData.DatabaseName := ExtractFilePath(fle);
TmpData.SQL.Text := format('Select * from "%s"', [ExtractFileName(fle)]);
{$ENDIF}
if not TmpData.Active then TmpData.Open;
TmpData.First;
Result := not TmpData.IsEmpty;
except
Result := False;
End;
End;
Function TStock_frm.GetData(tbl: String): Boolean;
Begin
{$IFDEF USEADO}
if tbl='pos' then
tb1 := format('%s%sMaster.xml', [TmpDir, tbl])
else
tb1 := format('%s%s.xml', [TmpDir, tbl]);
tb2 := format('%s%sdetail.xml', [TmpDir, tbl]);
{$ELSE}
tb1 := format('%s%s.db', [TmpDir, tbl]);
tb2 := format('%s%sdetail.db', [TmpDir, tbl]);
{$ENDIF}
Result := GetTempData(Master, tb1) and GetTempData(Detail, tb2);
if Master.FindField('Company')<>nil then
Company := Master.FieldByName('Company').AsString;
if Master.FindField('Direction')<>nil then
Direction := Master.FieldByName('Direction').AsInteger;
m.DataSet := Master;
d.DataSet := Detail;
End;
//dll 模块结束
//windows 消息机制处理 与发送
1、先在类中public 中定义接收消息的过程
Type
ProceDure ShowMyMsg(var Msg:TMessage); message WM_USER +1; //WM_USER+1 消息编码,根据这个接收消息内容
end;
procedure TForm1.btn2Click(Sender: TObject);
begin //WM_USER+1 消息编码,根据这个接收消息内容
SendMessage(self.Handle,WM_USER+1,100,Integer(PChar('你好!')));
end;
procedure TForm1.ShowMyMsg(var Msg: TMessage);
begin
//打印接收的消息
ShowMessage(PChar(Msg.LParam));
end;
//--------------------------------------------------------------------------------------
InterfaceTest 单元
unit InterfaceTest;
interface
//自定义接口
uses Dialogs;
Type IColor =interface
end;
IAinal =class(TInterfacedObject)
public
procedure Run();virtual;abstract;
end;
TDog =class(IAinal,IColor)
public
procedure Run();override;
procedure LookDoor();
end;
TCat =class(IAinal) //实现类
public
procedure Run();override;
procedure CatMouse();
end;
implementation
{ TDog }
procedure TDog.LookDoor;
begin
ShowMessage('狗看门');
end;
procedure TDog.Run;
begin
ShowMessage('狗在跑');
end;
{ TCat }
procedure TCat.CatMouse;
begin
ShowMessage('猫捉shu');
end;
procedure TCat.Run;
begin
ShowMessage('猫在跑');
end;
end.
//unit 单元 调用
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls, StdCtrls, DB, ADODB,frame1, sSkinManager, Buttons,InterfaceTest;
type
TForm1 = class(TForm)
pnl1: TPanel;
pnl2: TPanel;
con1: TADOConnection;
qry1: TADOQuery;
ComboBox1: TComboBox;
btn1: TButton;
Label1: TLabel;
sSkinManager1: TsSkinManager;
pnl3: TPanel;
lbl1: TLabel;
btn2: TButton;
btn3: TButton;
btn4: TButton;
procedure FormShow(Sender: TObject);
procedure btn1Click(Sender: TObject);
procedure lbl1Click(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure btn2Click(Sender: TObject);
procedure btn3Click(Sender: TObject);
procedure btn4Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
procedure ShowMyMsg(var Msg:TMessage); message WM_USER +1;
procedure ShowAnialRun(Ainal:TAinal);
end;
//用户传输消息的结构
type TMyMsg=record
MsgNum:Cardinal;//相当于long型 消息号
MsgText:ShortString; //传输的消息内容
end;
//消息处理类
type TMsgAccepter =class //默认继承 TObject 类相当于 class(TObject)
private
procedure Accepter2000(var Msg:TMyMsg); message 2000;
public
procedure DefaultHandler(var Message);override; //重写这个方法
end;
var
Form1: TForm1;
fra:TFrame2;
implementation
{$R *.dfm}
procedure TForm1.btn1Click(Sender: TObject);
begin
fra :=TFrame2.Create(application);
fra.Parent := pnl1;
fra.Top :=5;
end;
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
ShowMessage('触发关闭事件');
end;
procedure TForm1.FormShow(Sender: TObject);
var i,MaxWidth,Width:Integer;
dog:TDog;
begin
i:=0; //计数
MaxWidth:=0;
Qry1.SQL.Clear;
Qry1.SQL.Add('select UserName from [user]');
Qry1.Open;
//读客户列表到下拉框
while not Qry1.Eof do begin
ComboBox1.Items.add(Qry1.FieldByName('UserName').AsString);
Width:=ComboBox1.Font.Size * Length(ComboBox1.Items[i]);
if Width>MaxWidth then
MaxWidth:=Width; //找出最大值
qry1.Next;
i:=i+1;
end;
Qry1.Close;
ComboBox1.Text:=ComboBox1.Items[0];
//发送消息以确定显示区域的宽度 用发送消息的类型,自动告诉控件的最适合的宽度
SendMessage(ComboBox1.Handle, CB_SETDROPPEDWIDTH,MaxWidth,0);
// ComboBox1.Width :=MaxWidth;
ShowAnialRun(TDog.Create);
end;
procedure TForm1.lbl1Click(Sender: TObject);
begin
Close;
end;
procedure TForm1.btn2Click(Sender: TObject);
begin //WM_USER+1 i消息编码,根据这个接收消息内容
SendMessage(self.Handle,WM_USER+1,100,Integer(PChar('你好!')));
end;
procedure TForm1.btn3Click(Sender: TObject);
var msg:TMyMsg;
msgAccept:TMsgAccepter;
begin
msg.MsgNum :=2000;
msg.MsgText :='消息的内容aaaa';
msgAccept := TMsgAccepter.Create;
msgAccept.Dispatch(msg); //此方法 在TObject中
end;
procedure TForm1.btn4Click(Sender: TObject);
var msg:TMyMsg;
msgAccept:TMsgAccepter;
begin
msg.MsgNum :=2003;
msg.MsgText :='消息的内容aaaa';
msgAccept := TMsgAccepter.Create;
msgAccept.Dispatch(msg);
end;
procedure TForm1.ShowMyMsg(var Msg: TMessage);
begin
//打印接收的消息
ShowMessage(PChar(Msg.LParam));
end;
{ TMsgAccepter }
procedure TMsgAccepter.Accepter2000(var Msg: TMyMsg);
begin
ShowMessage('消息的编号'+IntToStr(Msg.MsgNum)+';消息的内容:'+Msg.MsgText);
end;
procedure TMsgAccepter.DefaultHandler(var Message);
var Msg:TMyMsg;
begin
//inherited;
Msg :=TMyMsg(Message);
ShowMessage('这消息号无法处理'+IntToStr(msg.MsgNum));
end;
procedure TForm1.ShowAnialRun(Ainal:TAinal);
var Dog:TDog;
begin
Ainal.Run;
if Ainal.ClassName ='TDog' then
begin
Dog :=TDog(Ainal);
Dog.LookDoor;
end;
end;
end.
//动态查询目录下的dll 文件,把查询到文件放到一个TStringList中,再把每个放到一个TTestPlugIn,所有的都放在TList.add(TTestPlugIn) 变量中
----------------------------------------------------------------------
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs,WeatherWebService, weatherService,StdCtrls, Buttons,MidasLib, DB,
DBClient, GridsEh, DBGridEh, RzTabs,Tools, ExtCtrls, ActnList, Menus,ImageHlp; //工具类
type
TFrmMain = class(TForm)
BitBtn1: TBitBtn;
ClientDataSet1: TClientDataSet;
DBGridEh1: TDBGridEh;
DataSource1: TDataSource;
BitBtn2: TBitBtn;
DBGridEh2: TDBGridEh;
RzPageControl1: TRzPageControl;
TabSheet1: TRzTabSheet;
TabSheet2: TRzTabSheet;
GroupBox1: TGroupBox;
RadioGroup1: TRadioGroup;
RadioButton1: TRadioButton;
RadioButton2: TRadioButton;
RadioButton3: TRadioButton;
ActionList1: TActionList;
Action1: TAction;
Action2: TAction;
Action3: TAction;
Action4: TAction;
MainMenu1: TMainMenu;
N1: TMenuItem;
N2: TMenuItem;
N_Plugins: TMenuItem;
btn1: TBitBtn;
Memo1: TMemo;
procedure BitBtn1Click(Sender: TObject);
procedure ClientDataSet1AfterPost(DataSet: TDataSet);
procedure BitBtn2Click(Sender: TObject);
procedure RzPageControl1Close(Sender: TObject; var AllowClose: Boolean);
procedure FormShow(Sender: TObject);
procedure Action1Execute(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure btn1Click(Sender: TObject);
private
FForm: TForm;
procedure LoadPlugIns; //初始化插件 ,也就装载插件,并在菜单提供调用
procedure PlugInsClick(Sender: TObject); //插件菜单点击事件
procedure FreePlugIns; //释放插件
public
{ Public declarations }
end;
//定义接口函数类型
Type
TShowDLLForm =function(AHandle: THandle; ACaption: string): Boolean;
TGetCaption = function: Pchar;
EDLLLoadError = class(Exception);
//定义TTestPlugIn类,存放caption,Address,call等信息
TTestPlugIn = class
Caption: string;//存取加载后,GetCaption返回的标题
Address: THandle; //存取加载DLL的句柄
methodList:TStrings; //得到方法列表
// Call: Pointer; //存取ShowDLLForm函数句柄
end;
function GetCurUserName(str:PChar):PChar;
function GetDLLFileExports(
szFileName: PChar;
mStrings: TStrings
): Boolean;
var
FrmMain: TFrmMain;
// user:TUser; //record 类 可以 直接使用
// myclass:TMyClass; //要实例化后,才能使用
ShowDllForm: TShowDllForm; //声明接口函数类型
Plugins: TList; //存放每一个DLL加载后的相关信息
StopSearch: Boolean;
implementation
{$R *.dfm}
function GetDLLFileExports(
szFileName: PChar;
mStrings: TStrings
): Boolean;
var
hFile: THANDLE;
hFileMapping: THANDLE;
lpFileBase: Pointer;
pImg_DOS_Header: PImageDosHeader;
pImg_NT_Header: PImageNtHeaders;
pImg_Export_Dir: PImageExportDirectory;
ppdwNames: ^PDWORD;
szFunc: PChar;
i: Integer;
begin
Result := False;
if not Assigned(mStrings) then Exit;
hFile := CreateFile(szFileName, GENERIC_READ, FILE_SHARE_READ, nil,
OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0);
if(hFile = INVALID_HANDLE_VALUE) then Exit;
hFileMapping := CreateFileMapping(hFile, nil, PAGE_READONLY, 0, 0, nil);
if hFileMapping = 0 then
begin
CloseHandle(hFile);
Exit;
end;
lpFileBase := MapViewOfFile(hFileMapping, FILE_MAP_READ, 0, 0, 0);
if lpFileBase = nil then
begin
CloseHandle(hFileMapping);
CloseHandle(hFile);
Exit;
end;
pImg_DOS_Header := PImageDosHeader(lpFileBase);
pImg_NT_Header := PImageNtHeaders(
Integer(pImg_DOS_Header) + Integer(pImg_DOS_Header._lfanew));
if IsBadReadPtr(pImg_NT_Header, SizeOf(IMAGE_NT_HEADERS)) or
(pImg_NT_Header.Signature <> IMAGE_NT_SIGNATURE) then
begin
UnmapViewOfFile(lpFileBase);
CloseHandle(hFileMapping);
CloseHandle(hFile);
Exit;
end;
pImg_Export_Dir := PImageExportDirectory(
pImg_NT_Header.OptionalHeader.DataDirectory[IMAGE_DIRECTORY_ENTRY_EXPORT].
VirtualAddress);
if not Assigned(pImg_Export_Dir) then
begin
UnmapViewOfFile(lpFileBase);
CloseHandle(hFileMapping);
CloseHandle(hFile);
Exit;
end;
// 63 63 72 75 6E 2E 63 6F 6D
pImg_Export_Dir := PImageExportDirectory(
ImageRvaToVa(pImg_NT_Header, pImg_DOS_Header, DWORD(pImg_Export_Dir),
PImageSectionHeader(Pointer(nil)^)));
ppdwNames := Pointer(pImg_Export_Dir.AddressOfNames);
ppdwNames := Pointer(ImageRvaToVa(pImg_NT_Header, pImg_DOS_Header,
DWORD(ppdwNames), PImageSectionHeader(Pointer(nil)^)));
if not Assigned(ppdwNames) then
begin
UnmapViewOfFile(lpFileBase);
CloseHandle(hFileMapping);
CloseHandle(hFile);
Exit;
end;
for i := 0 to pImg_Export_Dir.NumberOfNames - 1 do
begin
szFunc := PChar(ImageRvaToVa(pImg_NT_Header, pImg_DOS_Header,
DWORD(ppdwNames^), PImageSectionHeader(Pointer(nil)^)));
mStrings.Add(szFunc);
Inc(ppdwNames);
end;
UnmapViewOfFile(lpFileBase);
CloseHandle(hFileMapping);
CloseHandle(hFile);
Result := True;
end;
//查找文件,并存于Files中
procedure SearchFileExt(const Dir, Ext: string; Files: TStrings);
var
Found: TSearchRec;
Sub: string;
i: Integer;
Dirs: TStrings;
Finished: Integer;
begin
StopSearch := False;
Dirs := TStringList.Create;
Finished := FindFirst(Dir + '*.*', 63, Found);
while (Finished = 0) and not (StopSearch) do
begin
if (Found.Name[1] <> '.') then
begin
if (Found.Attr and faDirectory = faDirectory) then
Dirs.Add(Dir + Found.Name) //Add to the directories list.
else
if Pos(UpperCase(Ext), UpperCase(Found.Name)) > 0 then
Files.Add(Dir + Found.Name);
end;
Finished := FindNext(Found);
end;
FindClose(Found);
StopSearch :=true; //关闭后,这个为真
if not StopSearch then
for i := 0 to Dirs.Count - 1 do
SearchFileExt(Dirs[i], Ext, Files);
Dirs.Free;
end;
//初始化插件 ,也就装载插件,并在菜单提供调用
procedure TfrmMain.LoadPlugIns;
var
Files,Method: TStrings;
i: Integer;
TestPlugIn: TTestPlugIn;
NewMenu: TMenuItem;
GetCaption: TGetCaption;
begin
Files := TStringList.Create;
Plugins := TList.Create;
//查找指定目录下的.dll文件,并存于Files对象中
//ShowMessage(ExtractFilepath(Application.Exename));
SearchFileExt(ExtractFilepath(Application.Exename), '.dll', Files);
Method := TStringList.Create;
//加载查找到的DLL
for i := 0 to Files.Count - 1 do
begin
ShowMessage(Files[i]);
TestPlugIn := TTestPlugIn.Create;
TestPlugIn.Address := LoadLibrary(PChar(Files[i]));
if TestPlugIn.Address = 0 then
raise EDLLLoadError.Create('装载' + PChar(Files[i]) + '失败');
try
// @GetCaption := GetProcAddress(TestPlugIn.Address, 'GetCaption');
// TestPlugIn.Caption := GetCaption;
//TestPlugIn.Call := GetProcAddress(TestPlugIn.Address, 'ShowDLLForm');
//GetDLLFileExports('D:\webservice\Plugins.dll', Method);
GetDLLFileExports(PChar(Files[i]), Method);
TestPlugIn.methodList :=Method; //得到方法列表名称 为porint的
PlugIns.Add(TestPlugIn);
//创建菜单,并将菜单标题,Onclick事件赋值
NewMenu := TMenuItem.Create(Self);
NewMenu.Caption := TestPlugIn.Caption;
NewMenu.OnClick := PlugInsClick;
NewMenu.Tag := i;
N_plugins.Add(NewMenu); //每次在菜单下新增一个模块菜单
except
raise EDLLLoadError.Create('初始化失败');
end;
end;
Files.Free;
end;
//插件菜单点击事件
procedure TfrmMain.PlugInsClick(Sender: TObject);
begin
{
//根据菜单的tag属性对应函数调用的地址
@showDllForm := TTestPlugIn(PlugIns[TMenuItem(Sender).Tag]).Call;
//执行showDllForm函数
if not showDllForm(application.Handle, TTestPlugIn(PlugIns[TMenuItem(Sender).Tag]).caption) then
showmessage('打开窗体错误');
}
end;
//释放插件
procedure TfrmMain.FreePlugIns;
var
i: Integer;
begin
//将加载的插件全部释放
for i := 0 to PlugIns.Count - 1 do
begin
FreeLibrary(TTestPlugIn(PlugIns[i]).Address);
end;
//释放plugIns对象
PlugIns.Free;
end;
procedure TfrmMain.FormCreate(Sender: TObject);
begin
LoadPlugIns;
end;
procedure TfrmMain.FormDestroy(Sender: TObject);
begin
FreePlugins;
end;
function GetCurUserName(str:PChar):PChar;
begin
Result :='用户id1';
end;
procedure TFrmMain.Action1Execute(Sender: TObject);
begin
//在butoon中实现了关联
showMessage('aaa');
end;
procedure TFrmMain.BitBtn1Click(Sender: TObject);
var re:ArrayOfString;
datastr:WideString;
begin
{ re:= WeatherWebService.GetWeatherWebServiceSoap.getSupportCity('北京');
if re <>nil then
ShowMessage(re[0]);
}
// ShowMessage(weatherService.GetIWeather.queryCity('深圳'));
//ClientDataSet1.Active :=True;
datastr := weatherService.GetIWeather.getUserData();
// ShowMessage(datastr);
// ClientDataSet1.XMLData :=weatherService.GetIWeather.getUserData;
{ datastr :='<?xml version="1.0" encoding="UTF-8" standalone="yes"?> '+
' <DATAPACKET Version="2.0"> '+
' <METADATA> '+
' <FIELDS> '+
' <FIELD attrname="ID" fieldtype="i4"> </FIELD> '+
' <FIELD attrname="Name" fieldtype="string" WIDTH="12"/> '+
' <FIELD attrname="Age" fieldtype="ui2"/> '+
' <FIELD attrname="money" fieldtype="r8"/> '+
' <FIELD attrname="Sex" fieldtype="boolean"/> '+
' </FIELDS> '+
' </METADATA> '+
' <ROWDATA> '+
' <ROW RowState="4" ID="1" Name="张三" Age="33" money="23.89" Sex="TRUE"/>'+
' <ROW RowState="4" ID="2" Name="李四" Age="44" money="185.895" Sex="FALSE"/>'+
' <ROW RowState="4" ID="3" Name="王五" Age="55" money="158.448" Sex="TRUE"/> '+
' <ROW RowState="4" ID="4" Name="刘七" Age="505" money="48.987" Sex="TRUE"/> '+
' <ROW RowState="4" ID="8" Age="585" money="985.5885" Sex="TRUE"/> '+
' <ROW RowState="4" Name="test" Age="575" money="1.898" Sex="TRUE"/> '+
' <ROW RowState="4" ID="19" Name="" Age="589" money="158.358" Sex="TRUE"/> ' +
' </ROWDATA> '+
'</DATAPACKET>'; }
// ClientDataSet1.Close;
// ClientDataSet1.Open;
ClientDataSet1.XMLData := datastr;
end;
procedure TFrmMain.BitBtn2Click(Sender: TObject);
var cds2:TClientDataSet;
ds:TDataSource;
begin
{ cds2 :=TClientDataSet.Create(self);
cds2.Data := ClientDataSet1.Delta;
ds := TDataSource.Create(self);
ds.DataSet := cds2;
DBGridEh2.DataSource :=ds; }
end;
procedure TFrmMain.btn1Click(Sender: TObject);
begin
// PlugInsClick(Sender);
// ShowMessage(IntToStr(Plugins.Count))
// GetDLLFileExports('D:\webservice\Plugins.dll', Memo1.Lines);
end;
procedure TFrmMain.ClientDataSet1AfterPost(DataSet: TDataSet);
begin
if Dataset.FindField('Name') <>nil then
ShowMessage('名称字段')
end;
procedure TFrmMain.FormShow(Sender: TObject);
var hwn:THandle;
GetCurUserName:function(str:PChar):PChar;
StrList,ColName:TStringList;
str:String;
i,j:Integer;
Found: TSearchRec;
begin
// hwn :=LoadLibrary('StudyList.dll');
//if hwn<>0 then
// @GetCurUserName :=GetProcAddress(hwn,'GetCurUserName');
// SendMessage(nil,WM_SETTEXT,0,Cardinal('中语言'));
user.userid :=1;
user.username :='姓名aaaa';
user.password :='123456';
ShowMessage(user.getUser);
// myclass :=TMyClass.Create(1);
myclass.myid :=2;
myclass.SetUserName('英文','中文');
// ShowMessage(myclass.username);
str:='username|用户|2222;userid|ID值|2;password|密码|123456;departmentID|部门ID|0AB;stopFlag|是否信用|false';
ColName :=TStringList.Create;
StrList :=TStringList.Create;
StrList.Delimiter :=';'; //分隔符
StrList.DelimitedText :=str; //需要分隔的内容
ColName.Delimiter :='|';
// ShowMessage(IntToStr(StrList.Count));
for i := 0 to StrList.Count - 1 do
begin
//ColName.DelimitedText := StrList[i];
// ColName.Add(StrList[i]);
ColName.DelimitedText := StrList[i];
for j := 0 to ColName.Count - 1 do
begin
if('password'=ColName[j]) then
begin
// ShowMessage(IntToStr(j));
ShowMessage(ColName[j]);
// continue;
// break; //这里指的只跳出当前的 轮询 体,但外面还有一层所以还会继续走,外面的,外面的还会走进来
end;
// ShowMessage(ColName[j]);
//break;
// ShowMessage(ColName[j]);
end;
//ShowMessage(StrList[i]);
end;
end;
procedure TFrmMain.RzPageControl1Close(Sender: TObject; var AllowClose: Boolean);
begin
//如果只剩下一页不关闭,或当前页是首页不关闭
if (self.RzPageControl1.PageCount=1) or (self.RzPageControl1.ActivePage.Caption='首页') then
begin
AllowClose:=False;
Exit;
end;
AllowClose:=True;
end;
end.