unit UMainFuncs; { H2Reg.DLL + H2RegLib.DLL documented source code. Web Site: http://helpware.net/mshelp2/h2regdll.htm Exports SetPassword, GetH2Ver, NSExists, Reg_Namespace, Reg_Title, Reg_PlugIn, Reg_Filter, UnReg_Filter, UnReg_PlugIn, UnReg_Title, UnReg_Namespace, NS_IsMergeFilesBusy, NS_StartMergeFiles, NS_IsMergePending, //Not available in smaller h2reglib.dll version RunScriptFile; //Not available in smaller h2reglib.dll version } //Include Scripting Support for H2Reg.DLL build {$define IncludeCode_RunScriptFile} interface uses {$ifdef IncludeCode_RunScriptFile} //use only for Script code - will pull in alot of code. hh_funcs, URegScript, UH2_Merge, {$endif} Windows, SysUtils, UH2_Special, USupport; {Utils} procedure SetPassword(pw: pchar); stdcall; function GetH2Ver: PChar; stdcall; function NSExists(nsName: PChar): Bool; stdcall; {Register} function Reg_Namespace(_nsName, _nsColFile, _nsDesc: PChar): Integer; stdcall; function Reg_Title(_nsName, _TitleID: PChar; LangId: Integer; _HxS_HelpFile, _HxI_IndexFile, _HxQ_QueryFile, _HxR_AttrQueryFile, _HxsMediaLoc, _HxqMediaLoc, _HxrMediaLoc, _SampleMediaLoc: PChar): Integer; stdcall; function Reg_PlugIn(nsName_Parent, HxT_Parent, nsName_Child, HxT_Child, HxA_Child: PChar): Integer; stdcall; function Reg_Filter(nsName, FilterName, FilterQueryStr: PChar): Integer; stdcall; {Unregister} function UnReg_Filter(nsName, FilterName: PChar): Integer; stdcall; function UnReg_PlugIn(nsName_Parent, HxT_Parent, nsName_Child, HxT_Child, HxA_Child: PChar): Integer; stdcall; function UnReg_Title(nsName, TitleID: PChar; LangId: Integer): Integer; stdcall; function UnReg_Namespace(nsName: PChar): Integer; stdcall; {Merge Collection} function NS_IsMergeFilesBusy: Bool; stdcall; function NS_StartMergeFiles(nsName: PChar): Integer; stdcall; function NS_IsMergePending(nsName: PChar): Bool; stdcall; {Script File Support} function RunScriptFile(aScriptFile: PChar; aFlags: Integer): Integer; stdcall; implementation { ------------------------------------------------------------------------------ SetPassword(pw: pchar) ------------------------------------------------------------------------------ Redundant Function -- Password no longer used} ------------------------------------------------------------------------------ } procedure SetPassword(pw: pchar); stdcall; begin //** DLL is no longer protected USupport._pw := pw; //debug ///USupport.ShowMessage(_pw); end; { ------------------------------------------------------------------------------ GetH2Ver() ------------------------------------------------------------------------------ returns version of HxVz.Dll help engine as string x.x.x.x Typical installed to H:\Program Files\Common Files\Microsoft Shared\Help\hxvz.dll if H2 not installed or version is < 2.1.9254.0 (early Alpha release) then returns an empty str. Otherwise returns the version number as x.x.x.x H2 Version is documented here: http://helpware.net/mshelp2/info.htm ------------------------------------------------------------------------------ } function GetH2Ver: PChar; stdcall; var s: String; begin if CheckH2_9254OrGreater(S) then //true means a valid H2 version is found Result := PChar(s) else Result := ''; /// ///USupport.ShowMessage(S); end; //local func - H2 is install if found AND version is not an Alpha release. function H2Installed: Boolean; var s: String; begin Result := CheckH2_9254OrGreater(S); end; { ------------------------------------------------------------------------------ NSExists(nsName: PChar): Bool; ------------------------------------------------------------------------------ Returns true if H2 is installed and the specified Namespace is registered ------------------------------------------------------------------------------ } function NSExists(nsName: PChar): Bool; stdcall; begin Result := H2Installed and H2_IsValidNS(nsName); end; {=============================================================================== Equivalent H2Reg.EXE script sections [Reg_Namespace] [Reg_Title] [Reg_Plugin] [Reg_Filter] [UnReg_Plugin] [UnReg_Namespace] [UnReg_Title] [UnReg_Filter] ================================================================================} { ------------------------------------------------------------------------------ #1 - Reg_Namespace() ------------------------------------------------------------------------------ nsName - For a good registration we first unregister any existing namespace. To get bypass this action prefix the nsName with the "+" char. Return 0 - Registered OK 1 - Namespace param missing or contains spaces 2 - Supplied Col File (HxC or HxS) was not found 100 - Registration call failed 200 - MS Help 2 is not installed ------------------------------------------------------------------------------ } function Reg_Namespace( //3 Params _nsName, //Namespace to register - Don't use spaces!!! _nsColFile, //Full path to the Collection file (HxC/HxS) _nsDesc //Namespace description. : PChar): Integer; stdcall; var NS_AddIfNewMode: Boolean; nsName, nsColFile, nsDesc: String; begin if not H2Installed then begin Result := 200; Exit; end; CheckPW; nsName := _nsName; nsColFile := _nsColFile; nsDesc := _nsDesc; //There May be a "+" at the start of the line to signify "do not remove first" StripLR(nsName, ' '); NS_AddIfNewMode := (nsName <> '') and (nsName[1] = '+'); if NS_AddIfNewMode then Delete(nsName, 1, 1); //Remove the "+" //Validate Param 1 - nsName if (nsName = '') or (StrPosC(nsName, ' ') > 0) then begin Result := 1; Exit; end; //Validate Param 2 - Col file is NOT Optional if (not FileExists(nsColFile)) then begin Result := 2; Exit; end; //1.0.2 Fix - we unregister NS if already there - Start with a clean slate if H2_IsValidNS(nsName) then //already exists begin if not NS_AddIfNewMode then H2_UnRegisterNS(nsName); //remove ns - ignore any errors end; //Do it if Uh2_Special.H2_RegisterNS(nsName, nsDesc, nsColFile) then Result := 0 //Reg OK else Result := 100; //Reg failed end; { ------------------------------------------------------------------------------ #2 - Reg_Title() ------------------------------------------------------------------------------ Return 0 - Registered OK 1 - Namespace param does not exist (Must be name of an existing NS) 2 - TitleID param missing or contains spaces (illegal) 3 - Not used 4 - HxS file param is empty or not file found 5 - Optional HxI file specified but file was not found 6 - Optional HxQ file specified but file was not found 7 - Optional HxR file specified but file was not found 8 - Optional HxsMediaLoc directory specified but file was not found 9 - Optional HxqMediaLoc directory specified but file was not found 10 - Optional HxrMediaLoc directory specified but file was not found 11 - Optional SampleMediaLoc directory specified but file was not found 100 - Registration of Title failed 200 - H2 not installed ------------------------------------------------------------------------------ } function Reg_Title( // 11 Params _nsName, //Name of existing Namespace to register Title under - (Required) No Spaces!! _TitleID: PChar; //ID of Title - (Required). No Spaces!! LangId: Integer; //0 = default LCID - or 1033 etc _HxS_HelpFile, //Full path to HxS Help file - (Required) _HxI_IndexFile, //Optional - Full path to HxI file _HxQ_QueryFile, //Optional _HxR_AttrQueryFile, //Optional _HxsMediaLoc, //Optional _HxqMediaLoc, //Optional _HxrMediaLoc, //Optional _SampleMediaLoc //Optional : PChar): Integer; stdcall; var h2ti: TH2TitleInfo; nsName, TitleID, HxS_HelpFile, HxI_IndexFile, HxQ_QueryFile, HxR_AttrQueryFile, HxsMediaLoc, HxqMediaLoc, HxrMediaLoc, SampleMediaLoc: String; begin if not H2Installed then begin Result := 200; Exit; end; CheckPW; nsName := _nsName; TitleID := _TitleID; HxS_HelpFile := _HxS_HelpFile; HxI_IndexFile := _HxI_IndexFile; HxQ_QueryFile := _HxQ_QueryFile; HxR_AttrQueryFile := _HxR_AttrQueryFile; HxsMediaLoc := _HxsMediaLoc; HxqMediaLoc := _HxqMediaLoc; HxrMediaLoc := _HxrMediaLoc; SampleMediaLoc := _SampleMediaLoc; StripR(HxsMediaLoc, '\'); StripR(HxqMediaLoc, '\'); StripR(HxrMediaLoc, '\'); StripR(SampleMediaLoc, '\'); h2ti.TitleId := TitleID; h2ti.LangId := inttostr(LangID); h2ti.HxS_HelpFile := HxS_HelpFile; h2ti.HxI_IndexFile := HxI_IndexFile; h2ti.HxQ_QueryFile := HxQ_QueryFile; h2ti.HxR_AttrQueryFile := HxR_AttrQueryFile; h2ti.HxsMediaLoc := HxsMediaLoc; h2ti.HxqMediaLoc := HxqMediaLoc; h2ti.HxrMediaLoc := HxrMediaLoc; h2ti.SampleMediaLoc := SampleMediaLoc; //Validate Param 1 - nsName if (nsName = '') or (not H2_IsValidNS(nsName)) then //NS must exist begin Result := 1; Exit; end; //Validate Param 2 - TitleID if (TitleID = '') or (StrPosC(TitleID, ' ') > 0) then begin Result := 2; Exit; end; //Validate Param 3 - LangID //Validate Param 4 - HxS_HelpFile if not FileExists(HxS_HelpFile) then begin Result := 4; Exit; end; //Validate Param 5 - HxI_IndexFile (Optional) if (HxI_IndexFile <> '') and (not FileExists(HxI_IndexFile)) then begin Result := 5; Exit; end; //Validate Param 6 - HxI_IndexFile (Optional) if (HxQ_QueryFile <> '') and (not FileExists(HxQ_QueryFile)) then begin Result := 6; Exit; end; //Validate Param 7 - HxR_AttrQueryFile (Optional) if (HxR_AttrQueryFile <> '') and (not FileExists(HxR_AttrQueryFile)) then begin Result := 7; Exit; end; //Validate Param 8 - HxsMediaLoc (Optional) if (HxsMediaLoc <> '') and (not DirExists(HxsMediaLoc)) then begin Result := 8; Exit; end; //Validate Param 9 - HxqMediaLoc (Optional) if (HxqMediaLoc <> '') and (not DirExists(HxqMediaLoc)) then begin Result := 9; Exit; end; //Validate Param 10 - HxrMediaLoc (Optional) if (HxrMediaLoc <> '') and (not DirExists(HxrMediaLoc)) then begin Result := 10; Exit; end; //Validate Param 11 - SampleMediaLoc (Optional) if (SampleMediaLoc <> '') and (not DirExists(SampleMediaLoc)) then begin Result := 11; Exit; end; //Do it if H2_RegisterTitle2(nsName, h2ti) then Result := 0 else Result := 100 end; { ------------------------------------------------------------------------------ #3 - Reg_Plugin() ------------------------------------------------------------------------------ Return 0 - Registered OK 1 - nsName_Parent param does not exist (Must be name of an existing NS) 3 - nsName_Child param does not exist (Must be name of an existing NS) 5 - Optional HxA_Child file specified but file was not found (Must be full path) 100 - Registration call failed 200 - H2 not installed ------------------------------------------------------------------------------ } function Reg_PlugIn( //5 Params nsName_Parent, //nsName to plug into EG. MS.VSCC.2003 HxT_Parent, //Normally empty str - Or the name of the Parent HxT TOC (full path not reqd) nsName_Child, //nsName of child to plug into Parent HxT_Child, //Normally empty str - Or the name of the Child HxT TOC (full path not reqd) HxA_Child //Empty str - or full path to Childs HxA file (Only one that must be fully qualified path) : PChar ): Integer; stdcall; begin if not H2Installed then begin Result := 200; Exit; end; CheckPW; //Validate Param 1 - nsName_Parent if (nsName_Parent = '') or (not H2_IsValidNS(nsName_Parent)) then //NS must exist begin Result := 1; Exit; end; //Validate Param 3 - nsName_Child if (nsName_Child = '') or (not H2_IsValidNS(nsName_Child)) then //NS must exist begin Result := 3; Exit; end; //Validate Param 5 - HxA_Child (Optional) if (HxA_Child <> '') and (not FileExists(HxA_Child)) then begin Result := 5; Exit; end; //Do it if H2_DoPlugIn(nsName_Parent, HxT_Parent, nsName_Child, HxT_Child, HxA_Child) then Result := 0 //Reg OK else Result := 100; //Reg failed end; { ------------------------------------------------------------------------------ #4 - Reg_Filter() ------------------------------------------------------------------------------ Return 0 - Registered OK 1 - nsName param does not exist (Must be name of an existing NS) 100 - Registration call failed 200 - H2 not installed ------------------------------------------------------------------------------ } function Reg_Filter( //3 Params nsName, //nsName to add Filter to FilterName, //Name of Filter to add FilterQueryStr //Filter : PChar ): Integer; stdcall; begin if not H2Installed then begin Result := 200; Exit; end; CheckPW; //Validate Param 1 - nsName if (nsName = '') or (not H2_IsValidNS(nsName)) then //NS must exist begin Result := 1; Exit; end; //Do it if H2_AddFilter(nsName, FilterName, FilterQueryStr) then Result := 0 //Reg OK else Result := 100; //Reg failed end; { ------------------------------------------------------------------------------ #1 - UnReg_Filter() ------------------------------------------------------------------------------ Return 0 - Unregistered Filter OK 1 - nsName param does not exist (Must be name of an existing NS) 100 - Registration call failed 200 - H2 not installed ------------------------------------------------------------------------------ } function UnReg_Filter( //2 Params nsName, //nsName to remove Filter to FilterName //Name of Filter to remove : PChar ): Integer; stdcall; begin if not H2Installed then begin Result := 200; Exit; end; CheckPW; //Validate Param 1 - nsName if (nsName = '') or (not H2_IsValidNS(nsName)) then //NS must exist begin Result := 1; Exit; end; //Do it if H2_RemoveFilter(nsName, FilterName) then Result := 0 //Reg OK else Result := 100; //Reg failed end; { ------------------------------------------------------------------------------ #2 - UnReg_Plugin() ------------------------------------------------------------------------------ Return 0 - Unregistered Plugin OK 1 - nsName_Parent param does not exist (Must be name of an existing NS) -3 - **Warning Only** -- nsName_Child was not found to be a child of nsName_Parent -- Nothing to do 5 - Optional HxA_Child file specified but file was not found (Must be full path) 100 - Registration call failed 200 - H2 not installed ------------------------------------------------------------------------------ } function UnReg_PlugIn( //5 Params nsName_Parent, //Parent Namepsace to unplug from. EG. MS.VSCC HxT_Parent, //Normally empty str - Or the name of the Parent HxT TOC (full path not reqd) nsName_Child, //Child Namespace to unplug from Parent HxT_Child, //Normally empty str - Or the name of the Child HxT TOC (full path not reqd) HxA_Child //Empty str - or full path to Childs HxA file (Only one that must be fully qualified path) : PChar ): Integer; stdcall; begin if not H2Installed then begin Result := 200; Exit; end; CheckPW; //Validate Param 1 - nsName_Parent if (nsName_Parent = '') or (not H2_IsValidNS(nsName_Parent)) then //NS must exist begin Result := 1; Exit; end; //We will allowing an non-existing child NS - the Unplug can handle it //Is Child actually plugged into Parent if H2_IsPluggedIntoNS(nsName_Parent, nsName_Child) = false then begin Result := -3; //warning only -- Nothing to do Exit; end; //Validate Param 5 - HxA_Child (Optional) if (HxA_Child <> '') and (not FileExists(HxA_Child)) then HxA_Child := ''; //don't push our luck trying to unregister a file we cannot find //Do it if H2_UnDoPlugIn_BugFix(nsName_Parent, HxT_Parent, nsName_Child, HxT_Child, HxA_Child) then Result := 0 //Reg OK else Result := 100; //Reg failed end; { ------------------------------------------------------------------------------ #3 - UnReg_Title() ------------------------------------------------------------------------------ Return 0 - Unregistered Title OK 1 - Namespace param does not exist (Must be name of an existing NS) 2 - TitleID param missing - cannot be empty 100 - Registration of Title failed 200 - H2 not installed ------------------------------------------------------------------------------ } function UnReg_Title( // 3 Params nsName, //Name of existing Namespace to unregister Title from - (Required) TitleID: PChar; //ID of Title to remove LangId: Integer //0 = default LCID - or 1033 etc ): Integer; stdcall; begin if not H2Installed then begin Result := 200; Exit; end; CheckPW; //Validate Param 1 - nsName if (nsName = '') or (not H2_IsValidNS(nsName)) then //NS must exist begin Result := 1; Exit; end; //Validate Param 2 - TitleID if (TitleID = '') then begin Result := 2; Exit; end; //Do it if H2_UnRegisterTitle2(nsName, TitleID, inttostr(LangId)) {ns, TitleID, LangID} then Result := 0 else Result := 100 end; { ------------------------------------------------------------------------------ #4 - UnReg_Namespace() ------------------------------------------------------------------------------ Takes out every thing. Namespace/Titles/Plugins/Filters associated with NS Return 0 - UnRegistered OK 1 - Namespace param Empty -1 - **Warning Only** -- Namespace Not found - Nothing to do 100 - Registration call failed 200 - H2 not installed ------------------------------------------------------------------------------ } function UnReg_Namespace( //1 Params nsName: PChar //Namespace to unregister ): Integer; stdcall; begin if not H2Installed then begin Result := 200; Exit; end; CheckPW; //Validate Param 1 - nsName if (nsName = '') then //NS must exist begin Result := 1; Exit; end; //Validate Param 1 - nsName if (not H2_IsValidNS(nsName)) then //NS must exist begin Result := -1; //Warning - Nothing to remove - its already been removed Exit; end; //Do it if Uh2_Special.H2_UnRegisterNS(nsName) {ns} then Result := 0 //Reg OK else Result := 100; //Reg failed end; { ------------------------------------------------------------------------------ NS_StartMergeFiles(Namespace) NS_IsMergeFilesBusy() ------------------------------------------------------------------------------ Perform Merge if TOC and Index files for a Namespace. Do this if pre-merge a namespace so that when the Namespace is opened in DExplore viewer there is no long delay. More Info see: http://helpware.net/mshelp2/h2faq.htm#optimize Note: We use an extra thread when calling this so the Application main thread doesn't lock Return -- NS_StartMergeFiles() 0 - OK 1 - Namespace param is empty or invalid 2 - Error - A Merge is already in progress. Try again latter. Call NS_IsMergeFilesBusy() 200 - H2 not installed Return -- NS_IsMergeFilesBusy() true - if NS_StartMergeFiles() has finished ------------------------------------------------------------------------------ } var _H2mit: TH2MergeIndexThread; { Because the callback (below) takes so long to complete you must call this in a repeatedly in loop until FALSE is returned. } function NS_IsMergeFilesBusy: Bool; stdcall; begin //Is there a Merge already running? Result := Assigned(_H2mit) and _H2mit.Busy; //Free if all done if Assigned(_H2mit) and (not _H2mit.Busy) then begin _H2mit.Free; _H2mit := nil; end; end; {Start the Merge Index - MS.VSCC can take 60 secs on a 1GHz Pentium} function NS_StartMergeFiles( //1 Params nsName: PChar //Namespace to generate merge files ): Integer; stdcall; begin if not H2Installed then begin Result := 200; Exit; end; CheckPW; Result := 0; //Is there a Merge already running? if NS_IsMergeFilesBusy then begin Result := 2; Exit; end; //Validate Param 1 - nsName if (not H2_IsValidNS(nsName)) then //NS must exist begin Result := 1; Exit; end; //Previous Merge completed? if Assigned(_H2mit) then _H2mit.Free; //Threaded Merge _H2mit := Uh2_Special.H2_MergeIndex_StartThread(nsName); end; { ------------------------------------------------------------------------------ NS_IsMergePending ------------------------------------------------------------------------------ Checks if a namespace requires a Merge. ++ Function is only available in the larger H2Reg.DLL Return true if Namespace exists and requires a Merge ------------------------------------------------------------------------------ } function NS_IsMergePending(nsName: PChar): Bool; stdcall; begin {$ifdef IncludeCode_RunScriptFile} Result := UH2_Merge.H2_IsMergePending(nsName); {$else} Result := false; {$endif} end; { ------------------------------------------------------------------------------ Run H2Reg script file. ------------------------------------------------------------------------------ ** Please see H2Reg.exe Online help for details about running H2Reg Script. ++ Function is only available in the larger DLL Params aScriptFile - Name of H2Reg_cmd.ini script file. - Can be relative path (relative to the location of the h2reg.dll). - If empty string then we try and load h2reg.ini in the dll folder (like h2reg.exe) aFlags - OR'd switches indicating what mode and INI script section(s) to run. 0x01 = Do Register sections (same as H2Reg.exe /R) 0x02 = Do Unregister sections (same as H2Reg.exe /U) 0x04 = Perform Merge (same as H2Reg.exe /M) 0x08 = Append Log (def overwrite) (same as H2Reg.exe /A) 0x10 (16) = Quiet Mode. No popups. (same as H2Reg.exe /Q) 0x20 (32) = Do not perform NT Logon Check. (same as H2Reg.exe /N) - Valid combinations are same h2reg.exe 1 = Register sections only 2 = Unregister sections only 3 = ** Illegal switch combination ** 4 = Merge section only (must have a Merge_Namespace section) 5 = Register + Merge 6 = Unregister + Merge etc - all other switch combinations are OK -- just done combine 1 + 2 Return 0 - Completed OK -- Check - log file for any registration errors 1 - Specified Script file not found 2 - Invalid aFlags switch combination 3 - This version of DLL does not have H2Reg.exe Script code compiled into it 4 - general error - see popup message ------------------------------------------------------------------------------ } function RunScriptFile( //2 Params aScriptFile: PChar; aFlags: Integer ): Integer; stdcall; var IniFile: String; FullDir: Boolean; begin Result := 0; //Produces larger DLL since Delphu Forms are required {$ifdef IncludeCode_RunScriptFile} //Full path to - Empty path will be resolved to the system INI name IniFile := aScriptFile; StripLR(IniFile, ' '); if (IniFile <> '') then begin //Unc path or dos type path excepted FullDir := ((Length(IniFile) > 2) AND (IniFile[1] = '/') AND (IniFile[2] = '/')) or ((Length(IniFile) > 2) AND (IniFile[2] = ':')); //Not full path - then add DLL folder if not FullDir then begin if IniFile[1] = '\' then IniFile := hh_funcs._ModuleDir + IniFile else IniFile := hh_funcs._ModuleDir + '\' + IniFile; end; if not FileExists(IniFile) then begin //Show Error if not quiet mode if (aFlags and $10)=0 then USupport.ShowMessage('RunScriptFile(): Script file not found: "' + aScriptFile + '"' + #13 + '"' +IniFile+'"'); Result := 1; Exit; end; end; //Need at least one of the main switches - 1 or 2 or 4. //Also 1 + 2 combination is illegal. if (((aFlags and $1)=0) and ((aFlags and $2)=0) and ((aFlags and $4)=0)) or (((aFlags and $1)<>0) and ((aFlags and $2)<>0)) then begin //Show Error if not quiet mode if (aFlags and $10)=0 then USupport.ShowMessage('RunScriptFile(): called with Invalid Flag parameter: "0x0' + inttohex(aFlags, 4) + '"'); Result := 2; Exit; end; //Do It try URegScript._Switch_RegisterMode := (aFlags and $01) <> 0; URegScript._Switch_UnRegisterMode := (aFlags and $02) <> 0; URegScript._Switch_MergeIndexes := (aFlags and $04) <> 0; URegScript._Switch_AppendMode := (aFlags and $08) <> 0; URegScript._Switch_QuietMode := (aFlags and $10) <> 0; URegScript._Switch_NoNTAdminCheck := (aFlags and $20) <> 0; URegScript._Script_Ini_filename := IniFile; if URegScript.Script_Initialization() then URegScript.__H2Reg.RegisterAll(_Switch_RegisterMode, _Switch_UnRegisterMode, _Switch_MergeIndexes) else Result := 4; finally URegScript.Script_Finalization(); end; {$else} //Function not found in this version of the DLL - H2RegLib.DLL Result := 3; Exit; {$endif} end; end.