mainunit.pas

三层的通用架构

    procedure ItemPropertyExecute(Sender: TObject);
    procedure SelectItemExecute(Sender: TObject);
    procedure SelectItemUpdate(Sender: TObject);
    procedure CutItemExecute(Sender: TObject);
    procedure CutItemUpdate(Sender: TObject);
    procedure NewGroupUpdate(Sender: TObject);
    procedure PasteItemUpdate(Sender: TObject);
    procedure BigIconUpdate(Sender: TObject);
    procedure BackExecute(Sender: TObject);
    procedure BackUpdate(Sender: TObject);
    procedure ForwardToExecute(Sender: TObject);
    procedure ForwardToUpdate(Sender: TObject);
    procedure UpToExecute(Sender: TObject);
    procedure UpToUpdate(Sender: TObject);
    procedure OpenItemUpdate(Sender: TObject);
    procedure SelectOpenUpdate(Sender: TObject);
    procedure ShowCaptionActionExecute(Sender: TObject);
    procedure ShowCaptionActionUpdate(Sender: TObject);
    procedure HideCaptionActionExecute(Sender: TObject);
    procedure HideCaptionActionUpdate(Sender: TObject);
    procedure SelectCaptionActionExecute(Sender: TObject);
    procedure SelectCaptionActionUpdate(Sender: TObject);
    procedure StatusBar1Resize(Sender: TObject);
    procedure Panel4Resize(Sender: TObject);
    procedure StatusBar1DrawPanel(StatusBar: TStatusBar;
      Panel: TStatusPanel; const Rect: TRect);
    procedure SortNameExecute(Sender: TObject);
    procedure SortIndexExecute(Sender: TObject);
    procedure DefaultGroupExecute(Sender: TObject);
    procedure DataBaseParamExecute(Sender: TObject);
    procedure SysParamExecute(Sender: TObject);
    procedure AboutExecute(Sender: TObject);
    procedure TreeView1StartDrag(Sender: TObject;
      var DragObject: TDragObject);
    procedure TreeView1DragDrop(Sender, Source: TObject; X, Y: Integer);
    procedure ListView1EndDrag(Sender, Target: TObject; X, Y: Integer);
    procedure UndoDeleteExecute(Sender: TObject);
    procedure UndoDeleteUpdate(Sender: TObject);
    procedure HelpTopicExecute(Sender: TObject);
    procedure Panel9Resize(Sender: TObject);
    procedure Panel10Resize(Sender: TObject);
    procedure HomePageExecute(Sender: TObject);
    procedure HomePageUpdate(Sender: TObject);
    procedure EmailToExecute(Sender: TObject);
    procedure EmailToUpdate(Sender: TObject);
    procedure Label3Click(Sender: TObject);
    procedure Label4Click(Sender: TObject);
    procedure SupportsActionExecute(Sender: TObject);
    procedure SupportsActionUpdate(Sender: TObject);
    procedure FormCanResize(Sender: TObject; var NewWidth,
      NewHeight: Integer; var Resize: Boolean);
    procedure FormShow(Sender: TObject);
    procedure FileExitExecute(Sender: TObject);
    procedure Label3MouseEnter(Sender: TObject);
    procedure Label3MouseLeave(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure LoginAgainExecute(Sender: TObject);
    procedure ChangePasswordExecute(Sender: TObject);
    procedure UserManagerExecute(Sender: TObject);
    procedure ActionList1Execute(Action: TBasicAction;
      var Handled: Boolean);
    procedure SaveIniExecute(Sender: TObject);
    procedure ListView1Editing(Sender: TObject; Item: TListItem;
      var AllowEdit: Boolean);
    procedure Splitter1CanResize(Sender: TObject; var NewSize: Integer;
      var Accept: Boolean);
    procedure Splitter3CanResize(Sender: TObject; var NewSize: Integer;
      var Accept: Boolean);
    procedure Timer1Timer(Sender: TObject);
    procedure CloseItemUpdate(Sender: TObject);
    procedure DefaultSelectOpenClick(Sender: TObject);
    procedure DefaultCloseItemClick(Sender: TObject);
    procedure DefaultSwitchToClick(Sender: TObject);
    procedure CloseAllExecute(Sender: TObject);
    procedure Database1BeforeConnect(Sender: TObject);
    procedure Database1AfterConnect(Sender: TObject);
    procedure Database1BeforeDisconnect(Sender: TObject);
    procedure Database1AfterDisconnect(Sender: TObject);
    procedure ADOConnection1BeforeConnect(Sender: TObject);
    procedure ADOConnection1AfterConnect(Sender: TObject);
    procedure ADOConnection1BeforeDisconnect(Sender: TObject);
    procedure ADOConnection1AfterDisconnect(Sender: TObject);
    procedure DCOMConnection1BeforeConnect(Sender: TObject);
    procedure DCOMConnection1AfterConnect(Sender: TObject);
    procedure DCOMConnection1AfterDisconnect(Sender: TObject);
    procedure SocketConnection1BeforeConnect(Sender: TObject);
    procedure SocketConnection1AfterConnect(Sender: TObject);
    procedure SocketConnection1AfterDisconnect(Sender: TObject);
    procedure WebConnection1BeforeConnect(Sender: TObject);
    procedure WebConnection1AfterConnect(Sender: TObject);
    procedure WebConnection1AfterDisconnect(Sender: TObject);
    procedure SoapConnection1BeforeConnect(Sender: TObject);
    procedure SoapConnection1AfterConnect(Sender: TObject);
    procedure SoapConnection1AfterDisconnect(Sender: TObject);
    procedure CorbaConnection1BeforeConnect(Sender: TObject);
    procedure CorbaConnection1AfterConnect(Sender: TObject);
    procedure CorbaConnection1AfterDisconnect(Sender: TObject);
    procedure Timer2Timer(Sender: TObject);
    procedure RegisterItExecute(Sender: TObject);
    procedure SaveIniUpdate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure Timer3Timer(Sender: TObject);
    procedure GUIDShowExecute(Sender: TObject);
    procedure ServerViewShowExecute(Sender: TObject);
    procedure FormKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure FormPaint(Sender: TObject);
    procedure PageScroller1Scroll(Sender: TObject; Shift: TShiftState; X,
      Y: Integer; Orientation: TPageScrollerOrientation;
      var Delta: Integer);
    procedure PageScroller1Resize(Sender: TObject);
    procedure Timer4Timer(Sender: TObject);
    procedure ApplicationEventsException(Sender: TObject; E: Exception);
    procedure RegisterItUpdate(Sender: TObject);
  private
    { Private declarations }
    FDefaultIcon: TIcon;
    FLoginTimes: Integer;
    FTickCount, FIdleDefault, FIdleMinutes, FMessageID: Cardinal;
    FPBHandle, FOpenedPBHandle: HWND;
    FIniFile, FUserFile: TMemIniFile;
    FHelpFile, FIniFileName, FUserFileName, FUserName, FUserRealName, FUserAliasName, FDefaultTitle, FCurrentGroup, FDBConnectType, FDragName, FErrorString: string;
    FAllList, FGroupList, FGroupExpandList, FImageFileList, FImageIndexList, FItemPropertyForms, FOpenedHandles, FLibHandles, FViewStrings: TStringList;
    FMiniFlag, FLogin, FUpdateFlag, FSortNameFlag, FGoMenuFlag, FEditFocused, FIniMustSave, FIniSaveFlag, FSetSelectOpen, FSetSelectOpening, FPBLocked, FPBLockedMe, FPBMessaging, FCheckEnabling: Boolean;
    FPoint: TPoint;
    FTreeViewNode: TTreeNode;
    FMyClipboard: TMyClipboard;
    FDefaultRDM: OleVariant;
    FLeft, FTop, FWidth, FHeight: Integer;
    FThread: TThread;
    FormPainting: Boolean;
    function ProcessIniFile(ResumeFlag: Boolean = True; SaveFlag: Boolean = True; Source: string = ''; Target: string = ''): Boolean;
    procedure CshUserFile;
    function ShowLoginForm(UserName: string = ''; Password: string = ''; Flag: Boolean = False): Boolean;
    procedure ExtractString(Source: string; Strings: TStrings; MinCount: Integer);
    function GetImageIndex(IndexString, FileString: string; Index: Integer): Integer;
    procedure ChangeTreeViewIcon(Node: TTreeNode);
    procedure ChangeListViewIcon(ListItem: TListItem);
    procedure AddTreeView(GroupName, Name: string);
    function AddListView(Name: string): TListItem;
    procedure ExecuteItem(ItemName, CaptionName, OpenType, FORMString, DLLString, EXEString, PBString: string);
    function NewSectionName(const BasicStr: string; First: Cardinal): string;
    procedure DeleteName(const Name: string);
    function SelectGroup(const GroupName: string; SelectFlag: Boolean = True; CurrentFlag: Boolean = False): Integer;
    function SelectName(const Name: string; SelectFlag: Boolean = False): Integer;
    procedure UpdateSysPara;
    procedure UpdateList(PreserveFlag: Boolean = True; TreeFlag: Boolean = True);
    procedure UpdateTreeView;
    function UpdateListView(DefaultFlag: Boolean = False): TListItem;
    procedure UpdateComboBox;
    procedure AddMenuItem;
    procedure ChangeBFMItem;
    function MoveToGroup(const Name, GroupName: string; DeleteFlag: Boolean = True): Boolean;
    procedure SetDeleteIcon;
    function ActionAllow(Name: string; HintFlag: Boolean = True; HintString: string = ''): Boolean;
    function CheckEnabled(CheckFlag: Boolean = True; PBFlag: Boolean = False; ChangeFlag: Boolean = False; EnableFlag: Boolean = True): Boolean;
    function CanCloseNow: Boolean;
    procedure SetAllTreeView(TreeView: TTreeView; UserName: string = '');
    procedure SetSelectOpenMenuItem;
    procedure AddOpenedHandle(aHandle: HWND);
    procedure SetCloseMenuItem;
    procedure SetDBEvents;
    procedure CheckPassword;
    procedure WmSysCommand(var Msg: TMessage); message WM_SYSCOMMAND;
    procedure CmDoSomething(var Msg: TMessage); message CM_DOSOMETHING;
    function AppWindowHook(var Msg: TMessage): Boolean;
    function GetColumnWidths: string;
  protected
    procedure CreateParams(var Params: TCreateParams); override;
  public
    { Public declarations }
    CorbaConnection1: TCorbaConnection;
    procedure ConnectionsUpdate;
    procedure ConnectionsView;
    procedure DoAddViewString(ViewString: string);
    procedure AddViewString(Flag: Boolean = False);
    function GetUserInfo(AllUsersFlag: Boolean; UserName, UserRealName: string): string;
    function SetUserValue(CurrentUser, UserName, Value: string; var ErrorString: string): Boolean;
    function GetADOConnectionString(UserName: string): string;
    procedure DoSetStatusBar;
    function ChangeCurrentPassword(UserName, UserRealName, NewPassword: string; EncryptFlag: Boolean): Boolean;
    procedure SetStatusBar;
    function CheckCurrentUser(UserName, Password: string; var TheUserName, TheUserRealName, TheUserAliasName: string; EncryptFlag: Boolean = False): Boolean;
    function CheckUser(UserName, Password: string; var TheUserName, TheUserRealName, TheUserAliasName: string; EncryptFlag: Boolean = False): Boolean;
    function Login(UserName, Password: string): Boolean;
    procedure Logout;
    function ProcessPassword(BasicStr, Value: string; ToNatural: Boolean = False): string;
    function ProcessPassword2(BasicStr, Value: string; ToNatural: Boolean = False): string;
    function SetUserPassword(Password1, Password2, Password3: string): Boolean;
    procedure SetUserGroupList;
    procedure SetUserList(UserGroupName: string);
    procedure SetRegisterString(UserName: string; RegisterString: string);
    procedure InitNameAllows(FName: string);
    procedure SetNameAllows(FName: string);
    function AddUserGroup(FName: string; DefaultUserGroup: string = ''): Boolean;
    function AddUser(FName, UserGroup: string; var NotUseFlag: Boolean): Boolean;
    function MoveUserToGroup(FName, UserGroup: string; var NotUseFlag: Boolean): Boolean;
    function DeleteUserGroup(FName: string): Boolean;
    function DeleteUser(FName: string): Boolean;
    procedure InitUserLoginTimes(FName: string);
    procedure SetUserLoginTimes(FName: string);
    procedure InitUserItem(FName: string);
    procedure SetUserItem(FName: string);
    procedure InitCOMSet(FName: string);
    procedure SetCOMSet(FName: string);
    procedure GetCOMFun(Index: Integer; var DLL: string; var FUN: string);
    function CanConnectNewObject(UserName: string; Flag: string = ''): Boolean;
    function GetCustomObjectClassName(UserName: string): string;
    function ProcessFileName(FileName: string; AppDirFlag: Boolean = True; SystemDirFlag: Boolean = False; DeleteFlag: Boolean = True): string;
    procedure SetItemName(aForm: TForm; ItemNameStr: string);
    procedure SetItemProperty(ItemNameStr: string; SaveFlag: Boolean);
    procedure InitProperty;
    procedure SetProperty;
    function ReplaceString(Str, SubStr: string; EndChar: Char; Value: string): string;
    procedure InitDBProperty(UserName: string = '');
    procedure SetDBProperty(UserName: string = '');
    function ConnectToDB(HintFlag: Boolean = True): Boolean;
    function DisConnectToDB(HintFlag: Boolean = False): Boolean;
  end;

var
  TheMainForm: TTheMainForm;
  Messagehook: HHOOK;
  PasswordResult: string;

implementation

uses
  ShareUnit, RDMUnit, LoginUnit, ChangePasswordUnit, UserUnit, UserItemUnit, SetCOMUnit, ItemPropertyUnit, SysParaUnit, DBParaUnit, LoginTimesUnit, ServerViewUnit, GUIDUnit, ConnectionsUnit;

{$R *.dfm}

function WndProcHook(Code: Integer; wParam, lParam: Longint): Longint; stdcall;
begin
  if Code = HC_ACTION then
  begin
    Result := 0;
    with TheMainForm do
    begin
      if FormPainting then
        Exit;
      if FLogin and ((FUserRealName = '') or not FUserFile.SectionExists(FUserRealName)) then
        FLogin := False;
      if PCWPSTRUCT(lParam)^.Message <> WM_TIMER then
      begin
        FIdleMinutes := 0;
        Timer1.Enabled := False;
        if FLogin and (Timer1.Interval > 0) and (LoginForm = nil) and (FIdleDefault > 0) and (FIdleDefault < 9999) then
          Timer1.Enabled := True;
        if not Timer2.Enabled and (Timer2.Interval > 0) then
          Timer2.Enabled := True;
      end;
      if not FIniMustSave and FLogin and (PCWPSTRUCT(lParam)^.message = WM_MOVE) and (PCWPSTRUCT(lParam)^.hwnd = Handle) then
        FIniMustSave := True;
      if not FIniMustSave and FLogin and IsWindowVisible(Handle) and (PCWPSTRUCT(lParam)^.hwnd = ListView1.Handle) and (GetColumnWidths <> FUserFile.ReadString(FUserRealName, 'ColumnWidths', '')) then
        FIniMustSave := True;
      if PCWPSTRUCT(lParam)^.message = WM_ACTIVATE then
      begin
        if (LoginForm <> nil) and IsWindowVisible(Handle) then
          ShowWindow(Handle, SW_HIDE);
        if IsWindowVisible(Application.Handle) then
          ShowWindow(Application.Handle, SW_HIDE);
        if LoWord(PCWPSTRUCT(lParam)^.wParam) <> WA_INACTIVE then
          hMapView^.ActiveHandle := GetActiveWindow;
      end;
      if (PCWPSTRUCT(lParam)^.message = WM_NCACTIVATE) and (PCWPSTRUCT(lParam)^.hwnd <> hMapView^.ActiveHandle) and IsWindow(hMapView^.ActiveHandle) and IsWindowVisible(hMapView^.ActiveHandle) and not IsWindowEnabled(Handle) then
        PostMessage(hMapView^.ActiveHandle, WM_ACTIVATE, WA_ACTIVE, hMapView^.ActiveHandle);
      if (PCWPSTRUCT(lParam)^.message = WM_NCACTIVATE) and (PCWPSTRUCT(lParam)^.hwnd = Handle) then
        if LongBool(PCWPSTRUCT(lParam)^.wParam) then
        begin
          SetCloseMenuItem;
          StatusBar1.AutoHint := True;
        end
        else begin
          StatusBar1.AutoHint := False;
          StatusBar1.Panels[0].Text := Caption;
        end;
      if (GetActiveWindow = Handle) and (StatusBar1.Panels[0].Text = '') then
        StatusBar1.Panels[0].Text := Caption;
      if (FPBHandle > 0) and not IsWindow(FPBHandle) then
      begin
        if FDBConnectType = 'PBSQLCA' then
        begin
          FDBConnectType := '';
          SetStatusBar;
        end;
        if hMapView^.PBFlag = 1 then
          hMapView^.PBFlag := 0;
        FPBHandle := 0;
        FPBLocked := False;
        FPBLockedMe := False;
        FPBMessaging := False;
      end;
      if (FPBHandle > 0) and not FPBMessaging and not FCheckEnabling then
      begin
        if not FPBLockedMe then
        begin
          if IsWindowEnabled(Handle) then
          begin
            if FPBLocked then
            begin
              FCheckEnabling := True;
              FPBLocked := False;
              SendMessage(FPBHandle, FMessageID, 100, 1);
              FCheckEnabling := False;
            end;
          end
          else
            if not FPBLocked then
            begin
              FCheckEnabling := True;
              FPBLocked := True;
              PostMessage(FPBHandle, FMessageID, 100, 0);
              FCheckEnabling := False;
            end;
        end
        else
          if GetActiveWindow = GetForeGroundWindow then
            SetForeGroundWindow(FPBHandle);
        if not FPBLocked then
        begin
          if FPBLockedMe then
          begin
            if not CheckEnabled(False, True) then
            begin
              FCheckEnabling := True;
              FPBLockedMe := False;
              EnableWindow(Handle, True);
              EnableWindow(Application.Handle, True);
              CheckEnabled(True, False, True);
              FCheckEnabling := False;
            end;
          end
          else
            if not CheckEnabled(True, True) then
            begin
              FCheckEnabling := True;
              FPBLockedMe := True;
              EnableWindow(Handle, False);
              EnableWindow(Application.Handle, False);
              CheckEnabled(True, False, True, False);
              SendMessage(FPBHandle, FMessageID, 100, 1);
              FCheckEnabling := False;
            end;
        end;
      end;
      if Random(256) < 10 then
        if IsWindowEnabled(Handle) and (FHelpFile <> '') and (FileExists(FHelpFile) or (UpperCase(ExtractFileExt(FHelpFile)) <> '.HLP')) then
          Application.HelpFile := FHelpFile
        else
          Application.HelpFile := '';
    end;