Grideh与dll 消息/接口 使用操作

读取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.



 

评论
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值