mmscrsv.pas

一套及时通讯的原码

{-- TMMScreenSaver ------------------------------------------------------}
procedure TMMScreenSaver.HideCursor;
begin
    if PreviewMode then Exit;

    if not FHided then
    begin
        GetCursorPos(FSavePos);
        FSave := 0;
        while Windows.ShowCursor(False) >= 0 do Inc(FSave);
        FHided := True;
    end;
end;

{-- TMMScreenSaver ------------------------------------------------------}
procedure TMMScreenSaver.ShowCursor;
var
    i: Integer;
begin
    if PreviewMode then Exit;

    if FHided then
    begin
        for i := 0 to FSave do Windows.ShowCursor(True);
        SetCursorPos(FSavePos.X,FSavePos.Y);
        FHided := False;
    end;
end;

{-- TMMScreenSaver ------------------------------------------------------}
function TMMScreenSaver.GetSection: string;
begin
   Result := FSection;
end;

{-- TMMScreenSaver ------------------------------------------------------}
procedure TMMScreenSaver.SetTitle(aValue: String);
begin
   FTitle := Copy(aValue,1,15);
   Application.Title := 'SCRNSAVE:'+FTitle;
end;

{-- TMMScreenSaver ------------------------------------------------------}
Procedure TMMScreenSaver.SaverClose;
var
    CanClose: Boolean;
    hLib    : THandle;
    PCheckPW: function(Parent: THandle): Boolean; stdcall;
    Last    : THandle;
begin
   if FInClose or FClosing then Exit;

   FInClose := True;
   try
       CanClose := True;

       if not PreviewMode and _Win9x_ then
       begin
        if GetFromRegistry(HKEY_CURRENT_USER,'Control Panel\Desktop','ScreenSaveUsePassword',0) <> 0 then
        begin
           if Assigned(FOnPasswordSuspend) then FOnPasswordSuspend(Self);
           try
            ShowCursor;
            hLib := LoadLibrary('PASSWORD.CPL');
            if hLib <> 0 then
                try
                    PCheckPW := GetProcAddress(hLib, 'VerifyScreenSavePwd');
                    if Assigned(PCheckPW) then
                    begin
                        Last := GetFocus;
                        try
                            Application.NormalizeTopMosts;
                            try
                                CanClose := PCheckPW((Owner as TForm).Handle);
                            finally
                                Application.RestoreTopMosts;
                            end;
                        finally
                            SetFocus(Last);
                        end;
                    end;
                finally
                    FreeLibrary(hLib);
                end;
            HideCursor;
           finally
            if Assigned(FOnPasswordResume) then FOnPasswordResume(Self);
           end;
        end;
       end;

       if not CanClose then
       begin
        FPosition := Point(0,0);
        Exit;
       end;

       FClosing := True;

       if assigned(FOnSaverEnd) then FOnSaverEnd(Application);

       TForm(Owner).Perform(WM_CLOSE,0,0);
    finally
        FInClose := False;
    end;
end;

{-- TMMScreenSaver ------------------------------------------------------}
procedure TMMScreenSaver.Apptest(var Msg: TMsg; var Handled: Boolean);
begin
   if FFlag or (Owner=nil) then exit;

   case Msg.Message of
    WM_MOUSEMOVE:
    begin
       if PreviewMode or (Kind = skNormalWindow) then Exit;

       if (FPosition.X = 0) and (FPosition.Y = 0) then
       begin
          FPosition:=Point(LOWORD(msg.lParam), HIWORD(msg.lParam));
          Exit;
       end;
       if (Abs(FPosition.X-LOWORD(msg.lParam))>1) or (Abs(FPosition.Y-HIWORD(msg.lParam))>1) then
       begin
        msg.message:=0;
        msg.wParam := 0;
        msg.lParam := 0;
        Handled := True;
        SaverClose;
       end;
    end;
    WM_KEYDOWN,
    WM_SYSKEYDOWN,
    WM_RBUTTONDOWN,
    WM_LBUTTONDOWN,
    WM_MBUTTONDOWN:
    begin
       if not PreviewMode then
       begin
          if (Kind = skNormalWindow) then
          begin
             if (ssAlt in KeyDataToShiftState(Msg.lParam)) then
             begin
                if (Msg.wParam <> Byte('X')) and
                   (Msg.wParam <> VK_F4) then exit;
             end
             else if (Msg.wParam <> VK_ESCAPE) then exit;
          end;

          msg.Message:= 0;
          msg.wParam := 0;
          msg.lParam := 0;
          Handled := True;
          SaverClose;
       end;
    end;
   end;
end;

{-- TMMScreenSaver ------------------------------------------------------}
procedure TMMScreenSaver.CreateWrapper;
begin
    FOwnerProc := MakeObjectInstance(OwnerProc);
    FOldProc := TFarProc(GetWindowLong((Owner as TForm).Handle,GWL_WNDPROC));
    SetWindowLong((Owner as TForm).Handle,GWL_WNDPROC,LongInt(FOwnerProc));
end;

{-- TMMScreenSaver ------------------------------------------------------}
procedure TMMScreenSaver.DestroyWrapper;
begin
    if FOldProc <> nil then
        FOldProc := nil;

    if FOwnerProc <> nil then
    begin
        FreeObjectInstance(FOwnerProc);
        FOwnerProc := nil;
    end;
end;

{-- TMMScreenSaver ------------------------------------------------------}
procedure TMMScreenSaver.OwnerProc(var Msg: TMessage);
    procedure FormProc;
    begin
        Msg.Result := CallWindowProc(FOldProc,(Owner as TForm).Handle,Msg.Msg,Msg.WParam,Msg.LParam);
    end;
begin
    try
        if Msg.Msg = WM_SHOWWINDOW then
            if (Msg.wParam <> 0) and not FActivated then
                ResizeOwner;
        FormProc;
    except
        Application.HandleException(nil);
    end;
end;

{-- TMMScreenSaver ------------------------------------------------------}
function  TMMScreenSaver.GetFormParent: THandle;
begin
    Result := MMScrSv.ChildParent;
end;

{-- TMMScreenSaver ------------------------------------------------------}
function  TMMScreenSaver.GetKind: TMMScreenSaverKind;
begin
    Result := MMScrSv.Kind;
end;

{-- TMMScreenSaver ------------------------------------------------------}
procedure TMMScreenSaver.ResizeOwner;
var
    NewW, NewH: Integer;
    R : TRect;
begin
    if FActivated then
        Exit;

    if PreviewMode then
    begin
        GetClientRect(ChildParent,R);
        with Owner as TForm do
        begin
            NewW := R.Right-R.Left;
            NewH := R.Bottom-R.Top;
            if FPreviewScale and not FActivated then
            begin
                ScaleBy(R.Right-R.Left,Width);
            end;
            SetWindowPos(Handle,0,0,0,NewW,NewH,SWP_NOZORDER);
        end;
    end
    else
        (Owner as TForm).SetBounds(0,0,Screen.Width,Screen.Height);

    FActivated := True;
end;

{-- TMMScreenSaver ------------------------------------------------------}
function  TMMScreenSaver.GetPreviewMode: Boolean;
begin
    Result := Kind = skChildPreview;
end;

{-- TMMScreenSaver ------------------------------------------------------}
procedure TMMScreenSaver.CreateParams(var Params: TCreateParams);
begin
    if PreviewMode then
    begin
        Params.WndParent    := FormParent;
        Params.Style        := Params.Style and not WS_POPUP;
        Params.Style        := Params.Style or WS_CHILD;
    end;
end;

var
    Mutex      : THandle;
    hLib       : THandle;
    PChangePwd : function(a: PChar; ParentHandle: THandle; b, c :Integer): Integer; stdcall;

initialization
    if DesignMode then Exit;
    
    ShowWindow(Application.Handle,SW_HIDE);
    IsLibrary := False;
    GetSaverParams;

    if Kind = skSetPassword then
    begin
        if _Win9x_ then
        begin
            hLib    := LoadLibrary('MPR.DLL');
            if hLib <> 0 then
                try
                    PChangePwd := GetProcAddress(hLib,'PwdChangePasswordA');
                    if Assigned(PChangePwd) then
                        PChangePwd('SCRSAVE',ChildParent,0,0);
                finally
                    FreeLibrary(hLib);
                end;
        end;
        ForceAppQuit;
    end;
    Mutex := CreateMutex(nil,False,PChar('MMToolsScreenSaver'+
                                         ChangeFileExt(ExtractFileName(Application.ExeName),'')));
    if WaitForSingleObject(Mutex,10000) = WAIT_TIMEOUT then
        ForceAppQuit;

finalization
    if Mutex <> 0 then
    begin
        ReleaseMutex(Mutex);
        CloseHandle(Mutex);
    end;
    ShowWindow(Application.Handle,SW_SHOW);
end.