如何使用CreateProfile在Win SP2環境下? |
缺席
|
totony
一般會員 發表:3 回覆:20 積分:14 註冊:2004-05-12 發送簡訊給我 |
|
conundrum
尊榮會員 發表:893 回覆:1272 積分:643 註冊:2004-01-06 發送簡訊給我 |
http://www.imibo.com/imidev/delphi/les/Request05.HTM unit unMainServ; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, SvcMgr, Dialogs,ExtendedMAPI,unAdvice; type TDMAPIService = class(TService) procedure ServiceStart(Sender: TService; var Started: Boolean); procedure ServiceStop(Sender: TService; var Stopped: Boolean); private { Private declarations } szProfileName:PCHAR; MAPIINITOK:BOOL; function CreateProfileAndLogOn(const UserName,ServerName:PChar):bool; public FMapiSession:IMAPISession; function GetServiceController: TServiceController; override; { Public declarations } end; var DMAPIService: TDMAPIService; MailNotifi:TMailNotifier=nil; implementation uses EDKMDB,Registry; {$R *.DFM} // --HrCreateProfileName----------------------------------------------------- // Create a unique profile name for this MAPI session // -------------------------------------------------------------------------- function HrCreateProfileName(lpszPrefix:LPSTR; // prefix of profile name cBufferSize:ULONG; // size of buffer in bytes var lpszBuffer:LPSTR // buffer ):HRESULT; var hr:HRESULT; st:TSYSTEMTIME; ft:TFILETIME; cBytes:Integer; fRet:BOOL; label cleanup; begin hr:=0; ZeroMemory(lpszBuffer, cBufferSize); GetSystemTime(st); fRet := SystemTimeToFileTime(st, ft); if(fRet = FALSE) then begin hr := GetLastError(); goto cleanup; end; cBytes := FormatBuf(lpszBuffer^, cBufferSize, '%s %0.8x %0.8x %0.8x', strLen('%s %0.8x %0.8x %0.8x'), [lpszPrefix, GetCurrentProcessId(), ft.dwHighDateTime, ft.dwLowDateTime]); if (cBytes<0) then begin hr := (E_FAIL); goto cleanup; end; cleanup: if hr<>0 then ZeroMemory(lpszBuffer, cBufferSize); Result:=hr; end; function HrRemoveProfile(const lpszProfileName:LPSTR):HRESULT;stdcall; // profile name var hr:HRESULT; lpProfAdmin:IPROFADMIN; label cleanup; begin // // Connect to Profile Admin interface. // hr := MAPIAdminProfiles(0, lpProfAdmin); if(FAILED(hr)) then goto cleanup; // // Delete a MAPI profile // hr :=lpProfAdmin.DeleteProfile(lpszProfileName, 0); if(FAILED(hr)) then goto cleanup; cleanup: lpProfAdmin:=nil; Result:=hr; end; // // Create a unique profile name for this MAPI session, Log on to Exchange Server // and create AdviceSink object // function TDMAPIService.CreateProfileAndLogOn(const UserName,ServerName:PChar):bool; var hr:HRESULT; ulFlags:ULONG; lppProfAdmin:IPROFADMIN; lpServiceAdmin:IMsgServiceAdmin; lppTable:IMAPITABLE; pRows:LPSRowSet; lpProp : PSPropValueArray; I:byte; MsgStoreUID :LPMAPIUID; lppMAPIError:pMAPIError; MAPIINIT:TMAPIINIT; label cleanup; begin pRows:=nil; MsgStoreUID:=nil; ulFlags := MAPI_NEW_SESSION or MAPI_EXTENDED or MAPI_NO_MAIL or MAPI_NT_SERVICE or MAPI_BEST_ACCESS; MapiInit.ulVersion := MAPI_INIT_VERSION; MapiInit.ulFlags := MAPI_NT_SERVICE; hr:=mapiInitialize(@MAPIINIT); if failed(hr) then LogMessage('mapiInitialize HR: ' IntToStr(HR)); MAPIINITOK:=hr=S_OK; GetMem(szProfileName,MAX_PATH 1); // Create a unique profile name hr:=HrCreateProfileName('Test', MAX_PATH, szProfileName); if failed(hr) then LogMessage('HrCreateProfileName HR: ' IntToStr(HR)) else LogMessage('HrCreateProfileName : ' szProfileName, EVENTLOG_INFORMATION_TYPE); if MAPIINITOK then begin // Get pointer to administration object - IPROFADMIN interface hr:=MAPIAdminProfiles(0,lppProfAdmin); if failed(hr) then begin LogMessage('MAPIAdminProfiles HR: ' IntToStr(HR)); goto Cleanup; end; // We first try to delete profile (if exist) lppProfAdmin.DeleteProfile(szProfileName, 0); //HR CAN BE<>S_OK //Creates a new MAPI profile for service hr:=lppProfAdmin.CreateProfile(szProfileName, nil, 0, 0); if failed(hr) then begin LogMessage('lppProfAdmin.CreateProfile HR: ' IntToStr(HR)); goto cleanup; end; hr:=lppProfAdmin.AdminServices(szProfileName,nil,0,0,lpServiceAdmin); if failed(hr) then begin LogMessage('lppProfAdmin.AdminServices HR: ' IntToStr(HR)); goto cleanup; end; hr:=lpServiceAdmin.CreateMsgService('MSEMS',nil,0,0); if failed(hr) then begin LogMessage('lpServiceAdmin.CreateMsgService HR: ' IntToStr(HR)); goto cleanup; end; hr:=lpServiceAdmin.GetMsgServiceTable(0,lppTable); if(FAILED(hr)) then begin LogMessage('lpServiceAdmin.GetMsgServiceTable HR: ' IntToStr(HR)); goto cleanup; end; hr:=lppTable.QueryRows(1,0,pRows); if(FAILED(hr)) then begin LogMessage('lppTable.QueryRows HR: ' IntToStr(HR)); goto cleanup; end; for I:=0 to pRows.aRow[0].cValues-1 do if (pRows.aRow[0].lpProps[I].ulPropTag = PR_SERVICE_UID) then begin MsgStoreUID := LPMAPIUID(pRows.aRow[0].lpProps[I].Value.bin.lpb); break; end; I:=0; MAPIAllocateBuffer(sizeof(TSPropValueArray) sizeof(TSPropValue)*2,Pointer(lpProp)); MAPIAllocateMore(StrLen(UserName) 1,Pointer(lpProp),Pointer(lpProp[0].Value.lpszA)); MAPIAllocateMore(StrLen(ServerName) 1,Pointer(lpProp),Pointer(lpProp[I 1].Value.lpszA)); lpProp[0].ulPropTag := PR_PROFILE_UNRESOLVED_NAME; StrCopy(lpProp[0].Value.lpszA,UserName); lpProp[I 1].ulPropTag := PR_PROFILE_UNRESOLVED_SERVER; StrCopy(lpProp[I 1].Value.lpszA,ServerName); hr:=lpServiceAdmin.ConfigureMsgService( MsgStoreUID, 0, 0, 2, PSPropValue(lpProp)); if(FAILED(hr)) then begin lppMAPIError:=nil; lpServiceAdmin.GetLastError(hr,0,lppMAPIError); if Assigned(lppMAPIError) then if Assigned(lppMAPIError.lpszError) then LogMessage(lppMAPIError.lpszError) else LogMessage('lpServiceAdmin.ConfigureMsgService Error') else LogMessage('lpServiceAdmin.ConfigureMsgService Error'); goto cleanup; end; FMapiSession:=nil; hr:=MAPILogonEx(0, szProfileName, nil, ulFlags, FMapiSession); if(FAILED(hr)) then begin LogMessage('MAPILogonEx HR: ' IntToStr(HR)); goto cleanup; end; // We remove the profile. After "Log On", we no need it more. HrRemoveProfile(szProfileName); //Create AdviceSink object - Pls, see unAdvice unit. MailNotifi:=TMailNotifier.Create(FMapiSession); end; cleanup: if assigned(pRows) then FreePRows(pRows); lppTable:=nil; if assigned(lppMAPIError) then lppMAPIError:=nil; lpServiceAdmin:=nil; lppProfAdmin:=nil; Result:=hr=S_OK; end; procedure ServiceController(CtrlCode: DWord); stdcall; begin DMAPIService.Controller(CtrlCode); end; function TDMAPIService.GetServiceController: TServiceController; begin Result := ServiceController; end; procedure TDMAPIService.ServiceStart(Sender: TService; var Started: Boolean); const ImiboSystem = 'SOFTWARE\IMIBO\IMI Mailbox Notify Service\System'; var FInifile:TRegistry; lStarted:Bool; begin MAPIINITOK:=False; FInifile:=TRegistry.Create; FIniFile.Access:=KEY_ALL_ACCESS; FInifile.RootKey:=HKEY_LOCAL_MACHINE; FInifile.OpenKey(ImiboSystem,True); if ParamCount=3 then begin lStarted:=CreateProfileAndLogOn(PCHAR(Param[1]),PCHAR(Param[2])); if lStarted then begin FInifile.WriteString('Mailbox',Param[1]); FInifile.WriteString('Exchange Server',Param[2]); end; end else lStarted:=CreateProfileAndLogOn(PCHAR(FInifile.ReadString('Mailbox')),Pchar(FInifile.ReadString('Exchange Server'))); FInifile.CloseKey; FInifile.Free; Started:=lStarted; if Started then LogMessage('The DELPHI MAPI Notify NT Service is started!',EVENTLOG_INFORMATION_TYPE); end; procedure TDMAPIService.ServiceStop(Sender: TService; var Stopped: Boolean); begin if Assigned(MailNotifi) then MailNotifi.Free; If Assigned(FMapiSession) then Begin FMapiSession.Logoff(0,0,0); FMapiSession:=Nil; end; if MAPIINITOK then MAPIUninitialize; MAPIINITOK:=False; end; end. Source (DELPHI 6) in ZIP file Write us with any questions or comments Copyright © 1995-2004 IMIBO, EOODhttp://www.imibo.com/imidev/downloads/Request05EM6.zip |
totony
一般會員 發表:3 回覆:20 積分:14 註冊:2004-05-12 發送簡訊給我 |
Sorry...我設主題時沒想到其它的類別下也可能有CreateProfile這個function,我想知道的是IProvisioningProfileWireless::CreateProfile的用法…而conundrum大大提到的應該是IProfAdmin::CreateProfile這個類別的東東。
IProvisioningProfileWireless::CreateProfile跟XP中無線網路zero configuration 這個功能有關。 http://msdn.microsoft.com/library/default.asp?url=/library/en-us/eap/eap/iprovisioningprofilewireless_createprofile.asp
|
本站聲明 |
1. 本論壇為無營利行為之開放平台,所有文章都是由網友自行張貼,如牽涉到法律糾紛一切與本站無關。 2. 假如網友發表之內容涉及侵權,而損及您的利益,請立即通知版主刪除。 3. 請勿批評中華民國元首及政府或批評各政黨,是藍是綠本站無權干涉,但這裡不是政治性論壇! |