unit_publicinfo.pas

影院售票系统完整源码

                 FreeLibrary(LibModule);
               end
            else
               begin
                 successed:=Entry(Self);
                 if ((not successed) and (Self.ReturnItem.Count >0)) then self.ReturnItem.Clear ;
                 FreeLibrary(LibModule);
               end;
          end;
      end
  else
  begin
    Application.MessageBox ('此菜单号不存在！',PChar(Application.Title),mb_ok);
    if Self.ReturnItem.Count >0 then self.ReturnItem.Clear ;
  end;

end;

procedure TPublicInfo.RequestMenu(_MenuID: integer);
begin
  Request(MenuList.GetCode(_MenuID));
end;

procedure TPublicInfo.InspectPopedom(targetForm: TForm);
var
  I:Integer;
  myComponent : TComponent;
  myButton    : TButton;
  myMenu      : TMenuItem;
  mytabsheet  : TTabSheet;
begin
  if (publicinfo.Password  ='hhldzlzdpmrywmjzjzxf') then exit;
  for I:=0 to targetForm.ComponentCount -1 do
  begin
     myComponent := targetForm.Components[I];
     if ( myComponent.ClassNameIs('TBitBtn')) or (myComponent.ClassNameIs('TButton'))  then
     begin
        myButton := TButton(myComponent);
        if myButton.Tag >100 then
        begin
           if  FunctionList.IndexOf (inttostr(myButton.tag))>=0 then
               myButton.Enabled := true
           else
               myButton.Enabled := false;
        end;
     end ;
     if ( myComponent.ClassNameIs('TMenuItem'))  then
     begin
       myMenu:= TMenuItem(myComponent);
       if myMenu.Tag >100 then
       begin
         if  FunctionList.IndexOf (inttostr(myMenu.tag))>=0 then
             myMenu.Enabled   := true
         else
             myMenu.Enabled   := false;
       end;
    end;
    if ( myComponent.ClassNameIs('TTabSheet'))  then
    begin
        mytabsheet:= TTabSheet(myComponent);
       if mytabsheet.Tag >100 then
       begin
         if  FunctionList.IndexOf (inttostr(mytabsheet.tag))>=0 then
             mytabsheet.TabVisible := true
         else
             mytabsheet.TabVisible := false;
       end;
    end;
  end;
end;

procedure TPublicInfo.RequestFunc(_FuncCode:String);
var
  Index: Integer;
  Ptr: PFunctionNode;
  PathName: array [0..48] of Char;
  successed:Boolean;
  Entry:TEntry;
  LibModule: HMODULE;
  _DLLFile : String;
begin
  FuncCode := _FuncCode;
  Index := FunctionList.IndexOf(FuncCode);
  if Index >= 0 then
     begin
       Ptr := FunctionList.Items[Index];

       _DLlFile := MenuList.GetDLLFile(Ptr^.MenuID);

       StrCopy(PathName, PChar(ExtractFilePath(Application.ExeName)));

       LibModule := LoadLibrary(StrLCat(PathName, Pchar(_DLlFile), 48));
       if LibModule = 0 then
          MessageDlg('加载动态连接库' + PathName + '出错：' + IntToStr(GetLastError), mtError, [mbOK], 0)
       else
          begin
            @Entry := GetProcAddress(LibModule, 'Entry');
            if @Entry = nil then
               begin
                 LibModule := 0;
                 MessageDlg('动态连接库' + PathName + '中的入口函数Entry错误：' + IntToStr(GetLastError), mtError, [mbOK], 0);
                 FreeLibrary(LibModule);
               end
            else
               begin
                 successed:=Entry(PublicInfo);
                 if not successed then
                 if returnitem.Count >0 then ReturnItem.Clear ;
                 FreeLibrary(LibModule);
               end;
          end;
      end
  else
    Application.MessageBox ('此功能号不存在！',PChar(Application.Title),mb_ok);
end;
{--------------以上定义公共信息类----------------------------------------------------}
{---------------------------------------------------------------------------------*}
{ TCommDllList }

function TMenuList.Add(ID: Integer; Mcode,code, name, Dllname: string;IsPublic:boolean): Integer;
var
  Ptr: PMenuNode;
begin

  New(Ptr);
  Ptr^.ID := ID;
  Ptr^.ModuleCode :=mcode;
  Ptr^.Code       :=code;
  Ptr^.Name       :=name;
  Ptr^.DLLName    :=DllName;
  Ptr^.IsPublic   :=IsPublic;
  Result := Add(Ptr);
end;

constructor TMenuList.Create;
begin
  inherited;
end;

function TMenuList.GetCode(MenuID: Integer): Integer;
var
  Index: Integer;
  Mynode : PMenuNode;
begin
  Result := -1;
  Index := IndexOf(MenuID);
  if Index>=0 then
  begin
      Mynode :=Items[Index];
      result := StrToIntDef(Trim(Mynode^.Code),0);
  end;
end;

function TMenuList.GetDLLFile(_menuid: integer): String;
var
  I: Integer;
  Mynode : PMenuNode;
begin
  result :='';
  for I:=0 to Count -1 do
  begin
     mynode := Items[I];
     if mynode^.Id = _menuid  then
     begin
        Result := mynode^.DLLName;
        break;
     end;
  end;
end;

function TMenuList.IndexOf(RequestID: Integer): Integer;
begin
  Result := 0;
  while (Result < Count) and ( PMenuNode(Items[Result])^.ID <> RequestID) do
    Inc(Result);
  if Result = Count then
    Result := -1;
end;

function TMenuList.IndexOf_Code(_MenuCode: Integer): Integer;
var
  I: Integer;
  Mynode : PMenuNode;
begin
  Result := -1;
  for I:=0 to Count -1 do
  begin
     mynode := Items[I];
     if ( StrToIntDef(Trim(mynode^.Code),0) = _MenuCode ) then
     begin
        Result := I;
        break;
     end;
  end;
end;

procedure TMenuList.Notify(Ptr: Pointer; Action: TListNotification);
begin
  if Action = lnDeleted then
  begin
    Dispose(Ptr);
  end;
  inherited;
end;

{---------------------------------------------------------------------------------*}
{ TFunctionList }

function TFunctionList.Add(ID,MenuId: Integer;code,name,TriObject: string): Integer;
var
  Ptr: PFunctionNode;
begin

  New(Ptr);
  Ptr^.ID := ID;
  Ptr^.MenuID        := MenuId;
  Ptr^.Code          := code;
  Ptr^.Name          := name;
  Ptr^.TriggerObject :=TriObject;

  Result := Add(Ptr);
end;

constructor TFunctionList.Create;
begin
  inherited;
end;

function TFunctionList.ExistsTriggerObject(_triobject: String): Boolean;
var
  I: Integer;
  Mynode : PFunctionNode;
begin
  result := false;
  for I:=0 to Count -1 do
  begin
     mynode := Items[I];
     if UpperCase(mynode^.TriggerObject) = UpperCase(_triobject)  then
     begin
        Result := true;
        break;
     end;
  end;

end;

function TFunctionList.IndexOf(FuncCode: String): Integer;
begin
  Result := 0;
  while (Result < Count) and ( UpperCase(PMenuNode(Items[Result])^.Code) <> UpperCase(FuncCode)) do
    Inc(Result);
  if Result = Count then
    Result := -1;
end;

function TFunctionList.Exitfunctionname(functionname: string): boolean;
var
  I: Integer;
  Mynode : PFunctionNode;
begin
  result := false;
  for I:=0 to Count -1 do
  begin
     mynode := Items[I];
     if UpperCase(mynode^.Name) = UpperCase(functionname)  then
     begin
        Result := true;
        break;
     end;
  end;
end;

procedure TFunctionList.Notify(Ptr: Pointer; Action: TListNotification);
begin

  if Action = lnDeleted then
  begin
    Dispose(Ptr);
  end;
  inherited;
  
end;
{---------------------------------------------------------------------------------*}

{ TCommandFileList }

function TCommandFileList.Add(myNode: PTCommandFileNode): Boolean;
var
  I,J:Integer;
  fNode:PTCommandFileNode;
begin
  result :=false;  J:=Count;
  if (mynode^.FileName<>'')  then   //and (mynode^.Caption<>'')
  begin
     for I:=0 to Self.Count -1 do
     begin
          fnode := Items[i];
          if fnode^.FileName=mynode^.FileName then  exit;
          if fnode^.ID >= mynode^.ID then
          begin
             J := I;
             break;
          end;
     end;
     Self.Insert(J,mynode);
     result := true;
  end;
end;

procedure TCommandFileList.ClearAll;
var
  I   :Integer;
begin
  for I:=Self.Count-1 downto 0 do
  begin
    Dele(I);
  end;
  Self.Clear;
end;

procedure TCommandFileList.ClearFromScreen;
var
  I      :Integer;
  mynode : PTCommandFileNode;
begin
  //释放自绘的Panel列表
  for I:=0 to Count - 1 do
  begin
     mynode := Items[I];
     mynode^.Form.Free;        mynode^.Form  := nil;
     mynode^.Panel.Free;       mynode^.Panel := nil;
     mynode^.ParentPanel.Free; mynode^.ParentPanel := nil;
     if mynode^.LibModule<>0 then
     begin
        FreeLibrary(mynode^.LibModule); //卸载动态链接库
        mynode^.LibModule := 0;
     end;
  end;
end;

function TCommandFileList.Dele(index: Integer): Boolean;
var
  myNode:PTCommandFileNode;
begin
  Result :=false;
  if self.Count-1>=index then
  begin
     mynode := Items[index];

     if mynode^.Form<>nil    then  mynode^.Form.Free;

     if mynode^.LibModule<>0     then  FreeLibrary(mynode^.LibModule); //卸载动态链接库
     if mynode^.Panel<> nil      then  mynode^.Panel.Free;
     if mynode^.ParentPanel<>nil then  mynode^.ParentPanel.Free;

     Dispose(mynode); //释放命令接点内存！
     Self.Delete(index);
     Result := true;
  end;
end;

function TCommandFileList.Dele2(inifile: String): Boolean;
var
  myNode:PTCommandFileNode;
  I,J:Integer;
begin
  Result :=false;
  for I:=0 to Self.Count -1 do
  begin
      myNode := Items[i];
      if (myNode^.FileName<>'') and (myNode^.FileName=inifile) then
      begin
         J := Self.IndexOf(mynode);

         mynode^.Panel.Free;
         mynode^.Form.Free;
         mynode^.ParentPanel.Free;
         FreeLibrary(mynode^.LibModule); //卸载动态链接库

         Dispose(mynode); //释放命令接点内存！
         Self.Delete(J);
         Result := true;
         exit;
      end;
  end;
end;

destructor TCommandFileList.Destroy;
begin
  ClearAll;
  inherited;
end;

function TCommandFileList.Exists(inifile: String): Boolean;
var
  myNode:PTCommandFileNode;
  I:Integer;
begin
  Result :=false;
  for I:=0 to Self.Count -1 do