// TH3Workspace.pkg // By Sergey V. Natarov // Created: 11/03/2017 // This file defines TH3 Workspace (HWS extension) // HWS includes information about The Hammer Workspace // It is based on the Project workspace, but can be amended // by Developer Use Tools\TH3Workspace.h Use THColorer.h Use Flexml.pkg Declare_Datafile ASDB Declare_Datafile SYSFILE Declare_Datafile VDFCLS Declare_Datafile VDFPRNT Declare_Datafile VDFPROP // 2001-01-09 -RvdW #Replace CURRENT$WORKSPACE "Hammer" // 2001-01-09 -RvdW Use cApplicationEx.pkg Use Startup.pkg Object Splash_Screen is a SplashScreenPanel Set Bitmap to "LOGO.BMP" Send Activate End_Object Object oApplication is a cApplicationEx Property Integer piWrkSpcNewFile False Property Integer piWrkSpcSetVersion False Property Integer piWrkSpcRegister False Property String psWrkSpcOpenFileName "" Set piCmdLineSupport to True // Use it for CommandLine Parameters. Set psCompany to CTH_Project_Name Set psProduct to CTH_Programm_Name Set psVersion to CTH_Version_No Set peHelpType to htHtmlHelp #IF (!@ > 182) //@ RRS: Addded DF19 cConnection support Object oConnectionManager is a cConnectionManager // Set pbAutoConnect to False End_Object #ENDIF // Propeties to store some global flags. Object oWrkSpcOpenFileNames is an Array End_Object // Sends the given Message to the given Object with all given // Parameters. Procedure WrkSpcDoForAllFiles Integer iMsg Integer hoDest Integer hoID iC String sFile Move (oWrkSpcOpenFileNames(Self)) to hoID For iC from 0 to (Item_Count(hoID)-1) Get value of hoID item iC to sFile If sFile Ne "" If iMsg If hoDest Begin Send iMsg to hoDest sFile End Loop End_Procedure // Procedure which are called when the CommandLineParameters are received. Procedure WrkSpcRegister Set piWrkSpcRegister to True End_Procedure Procedure WrkSpcOpenFile String sFile Integer iArg String sArg Set psWrkSpcOpenFileName to sFile Send Delete_Data to (oWrkSpcOpenFileNames(Self)) For iArg from 1 to NUM_Arguments Movestr iArg& to sArg If (Trim(sArg)) Ne "" Begin Set value of (oWrkSpcOpenFileNames(Self)) item (Item_Count(oWrkSpcOpenFileNames(Self))) to sArg End Loop End_Procedure Procedure WrkSpcNewFile Set piWrkSpcNewFile to True End_Procedure Procedure WrkSpcSetVersion Set piWrkSpcSetVersion to True End_Procedure // Commands which should been handled from the CmdLine: Send RegisterCommand "-REGISTER" Msg_WrkSpcRegister 0 "Associates all VDF Filetypes to the Hammer." Send RegisterCommand "-OPEN" Msg_WrkSpcOpenFile 0 "Opens the given file." Send SetDefaultCommand // -OPEN is the default Command. Send RegisterCommand "-NEW" Msg_WrkSpcNewFile 0 "Opens a empty file view." Send RegisterCommand "-SETVERSION" Msg_WrkSpcSetVersion 0 "Opens the Version/ Workspace dialog on startup" Procedure OnCreate Send DoOpenWorkspace (CURRENT$WORKSPACE) End_Procedure Procedure OpenTH3DB Integer iFileNum Boolean bOpened String sFileName String sTH3DataPath tTH3DB[] TH3DB Get pTH3DB to TH3DB Get psDataPath of (phoWorkspace(Self)) to sTH3DataPath Get vFolderFormat sTH3DataPath to sTH3DataPath Get_Attribute DF_FILE_OPENED of iFileNum to bOpened If (bOpened) Begin Get_Attribute DF_FILE_PHYSICAL_NAME of iFileNum to sFileName Get ParseFileName sFileName to sFileName // we want no path End Case Begin Case (iFileNum=ASDB.File_Number) If (Uppercase(sFileName)<>"ASDB") Begin If (bOpened) Close iFileNum Open (sTH3DataPath+"ASDB") as ASDB Move True To TH3DB[iFileNum].bIsOpen Move bOpened To TH3DB[iFileNum].bReOpen End Else Begin Move bOpened To TH3DB[iFileNum].bIsOpen Move False To TH3DB[iFileNum].bReOpen End Case Break Case (iFileNum=SYSFILE.File_Number) If (Uppercase(sFileName)<>"SYSFILE") Begin If (bOpened) Close iFileNum Open (sTH3DataPath+"SYSFILE") as SYSFILE Move True To TH3DB[iFileNum].bIsOpen Move bOpened To TH3DB[iFileNum].bReOpen End Else Begin Move bOpened To TH3DB[iFileNum].bIsOpen Move False To TH3DB[iFileNum].bReOpen End Case Break Case (iFileNum=VDFCLS.File_Number) If (Uppercase(sFileName)<>"VDFCLS") Begin If (bOpened) Close iFileNum Open (sTH3DataPath+"VDFCLS") as VDFCLS Move True To TH3DB[iFileNum].bIsOpen Move bOpened To TH3DB[iFileNum].bReOpen End Else Begin Move bOpened To TH3DB[iFileNum].bIsOpen Move False To TH3DB[iFileNum].bReOpen End Case Break Case (iFileNum=VDFPRNT.File_Number) If (Uppercase(sFileName)<>"VDFCLS") Begin If (bOpened) Close iFileNum Open (sTH3DataPath+"VDFCLS") as VDFPRNT Set_Attribute DF_FILE_ALIAS Of VDFPRNT.File_number To DF_FILE_IS_ALIAS Set_Attribute DF_FILE_ALIAS Of VDFCLS.File_number To DF_FILE_IS_MASTER Move True To TH3DB[iFileNum].bIsOpen Move bOpened To TH3DB[iFileNum].bReOpen End Else Begin Move bOpened To TH3DB[iFileNum].bIsOpen Move False To TH3DB[iFileNum].bReOpen End Case Break Case (iFileNum=VDFPROP.File_Number) If (Uppercase(sFileName)<>"VDFPROP") Begin If (bOpened) Close iFileNum Open (sTH3DataPath+"VDFPROP") as VDFPROP Move True To TH3DB[iFileNum].bIsOpen Move bOpened To TH3DB[iFileNum].bReOpen End Else Begin Move bOpened To TH3DB[iFileNum].bIsOpen Move False To TH3DB[iFileNum].bReOpen End Case Break Case End Set pTH3DB to TH3DB End_Procedure Procedure CloseTH3DB Integer iFileNum Integer iSize tTH3DB[] TH3DB Get pTH3DB to TH3DB Move (SizeOfArray(TH3DB)-1) To iSize If (iFileNum>=iSize) Begin If (TH3DB[iFileNum].bIsOpen) Begin Close iFileNum Move False To TH3DB[iFileNum].bIsOpen End If (TH3DB[iFileNum].bReOpen) Begin Open iFileNum // reopens file that current filelist points to. End Set pTH3DB to TH3DB End End_Procedure End_Object // oApplication Function THWinRegClassesRootValue String sBranch String sKey Returns String Handle hCurrentRoot String sCurrentPath String sRetVal sValue UInteger hKey Integer iSize iError hRootKey Pointer psValue piSize pKey Get_Registry_Root to hCurrentRoot sCurrentPath Move 0 to hKey GetAddress of hKey to pKey Move (RegOpenKeyEx(HKEY_CLASSES_ROOT, ToAnsi(sBranch), 0, KEY_READ, pKey)) to iError If (hKey<>0) Begin Move 100 to iSize ZeroString iSize to sValue GetAddress of sValue to psValue GetAddress of iSize to piSize Move (RegQueryValueEx(hKey, sKey, 0, 0, AddressOf(sValue), AddressOf(iSize))) to iError Move (CString(sValue)) to sRetVal Move (RegCloseKey(hKey)) to iError End Set_Registry_Root to hCurrentRoot sCurrentPath Function_Return sRetVal End_Function // Provided as a list of Event IDs (but seems like not required) Function THCompilerEventID String sVersion Returns String If (sVersion="12.0") Function_Return "{E4C3F246-8F3B-49C6-88E9-3BE282B6990A}" If (sVersion="12.1") Function_Return "{6621490D-0725-44D0-ACF5-86B42A4718F9}" If (sVersion="14.0") Function_Return "{72F51D9A-D76E-474F-8ACE-3276FD7E9D61}" If (sVersion="14.1") Function_Return "{B4F4CE77-4CCB-4B64-9297-7A83484EAD0F}" If (sVersion="15.0") Function_Return "{2C4E9D67-AB48-4F73-8BF2-A837723F150B}" If (sVersion="15.1") Function_Return "{01367077-9E13-458E-B393-936C8DBF6BD2}" If (sVersion="16.0") Function_Return "{765949AB-411F-47B6-9DC8-CC2934DD6C93}" If (sVersion="16.1") Function_Return "{7EF7BDFC-193D-4852-BD42-8F29D8E13558}" If (sVersion="17.0") Function_Return "{DAA0B8DD-A193-4B44-89A4-0FD195158897}" If (sVersion="17.1") Function_Return "{05A055A7-F12E-4B10-A878-0CB4B1B91AF4}" If (sVersion="18.0") Function_Return "{D2508C70-B95A-4B3A-86C5-C043DE93A1CD}" If (sVersion="18.1") Function_Return "{A218E494-0D49-4FBC-B883-54C8312AB504}" If (sVersion="18.2") Function_Return "{3788BA01-C926-4B82-A3BD-936E67E00C54}" If (sVersion="19.0") Function_Return "{2C22F54E-164C-4B28-A089-5357B54A2371}" If (sVersion="19.1") Function_Return "" Function_Return "" End_Function Procedure THEnumerateBuiltInCompilers Integer iVersion iVersionStart iVersionStop iSubVersion iSubVersions iCompiler String sCompiler sVersion sResult sProgID sEventID tTHCompiler[] THCompilers Move 12 to iVersionStart Move 25 to iVersionStop Move 3 to iSubVersions Get pTHCompilers of ghoApplication To THCompilers For iVersion from iVersionStart to iVersionStop For iSubVersion from 0 to iSubVersions Move (String(iVersion)+"."+String(iSubVersion)) to sVersion Move ("vdfcompctl.VDFCompiler."+sVersion) to sCompiler Move (THWinRegClassesRootValue(Self, sCompiler, "")) to sResult If (Uppercase(sResult)="VDFCOMPILER OBJECT") Begin // Looks like it works perfectly without Event ID // Get THCompilerEventID sVersion to sEventID // If (sEventID<>"") Begin Move (SizeOfArray(THCompilers)) to iCompiler Move sVersion to THCompilers[iCompiler].sVersion Get THWinRegClassesRootValue (sCompiler+"\CLSID") "" to sProgID Move sProgID to THCompilers[iCompiler].sProgID Move sEventID to THCompilers[iCompiler].sEventId // End // EventID End // Compiler Object Loop Loop Set pTHCompilers of ghoApplication To THCompilers End_Procedure Send THEnumerateBuiltInCompilers Function THFindBuiltInCompiler String sVersion Returns Integer tTHCompiler ltTHCompiler tTHCompiler[] THCompilers Move sVersion To ltTHCompiler.sVersion Get pTHCompilers of ghoApplication To THCompilers Function_Return (SearchArray(ltTHCompiler, THCompilers)) End_Function Function THFindWorkspaceFile String sPath String sType Returns String String sWSFile Direct_Input ("DIR:"+sPath+"*."+sType) While (not(SeqEof)) Readln sWSFile If (sWSFile<>"") Break Loop Close_Input Function_Return sWSFile End_Function Function THNewWorkspaceName String sPath Returns String String sWSFile Number nVersion // Try to find DataFlex Workspace Get THFindWorkspaceFile sPath "SWS" to sWSFile If (sWSFile<>"") Move (Left(sWSFile, Length(sWSFile)-3)) to sWSFile Else Begin Get fnCurrentVdfVersion of ghoWorkspaceHandlerEx to nVersion If (nVersion<80) Begin // VDF7 and earlier didn't use SWS files Get CurrentWorkspaceTag of ghoWorkSpaceHandlerEx to sWSFile If (sWSFile<>"") Move (sWSFile+".") To sWSFile End Else Move "Project." to sWSFile End // If (sWSFile<>"") Move (sWSFile+"hws") To sWSFile Function_Return sWSFile End_Function Function THWorkspaceName String sPath Integer ByRef bNew Integer ByRef iType Returns String String sWSFile Direct_Input ("DIR:"+sPath+'*.hws') While (not(SeqEof)) Readln sWSFile If (sWSFile<>"") Break Loop Close_Input If (sWSFile="") Begin Get THNewWorkspaceName sPath to sWSFile If (sWSFile="") Move "Project.hws" to sWSFile Else Move 1 to iType // DataFlex Workspace Move 1 to bNew End Function_Return sWSFile End_Function // *** Load Language from Studio 12+ (Used by THParameters Dialog) // Loading from the Current Workspace Version Procedure LoadLanguageTokens String sLanguage String sElement Handle hoTokens Integer iList tTHLanguage ByRef ltTHLanguage Handle hoToken String sToken sStrings Integer iScopeStart iScopeStop iKeyword iOperator Move (Uppercase(sLanguage)) to sLanguage Get FirstChild of hoTokens to hoToken While (hoToken <> 0) Get psText of hoToken "" "" to sToken // Move (SizeOfArray(ltTHLanguage.saKeywords)) to iKeyword Move (SizeOfArray(ltTHLanguage.saScopeStart)) to iScopeStart Move (SizeOfArray(ltTHLanguage.saScopeStop)) to iScopeStop Move (SizeOfArray(ltTHLanguage.saOperators)) to iOperator // If ((sElement="BLOCKCOMMENTS")and(iList=0)) Move sToken to ltTHLanguage.sMultiLineCommentStart If ((sElement="BLOCKCOMMENTS")and(iList=1)) Move sToken to ltTHLanguage.sMultiLineCommentStop If ((sElement="1001")and(iList=0)) Move sToken to ltTHLanguage.sMetaStart If ((sElement="1001")and(iList=1)) Move sToken to ltTHLanguage.sMetaStop If (sElement="LINECOMMENTS") Move sToken to ltTHLanguage.sLineComments If (sElement="1002") Move sToken to ltTHLanguage.saKeywords[iKeyword] // Use|#Include If ((sElement="DEFINITIONBLOCKS")and(iList=0)) Move sToken to ltTHLanguage.saScopeStart[iScopeStart] If ((sElement="DEFINITIONBLOCKS")and(iList=1)) Move sToken to ltTHLanguage.saScopeStop[iScopeStop] If ((sElement="SCOPEKEYWORDS")and(iList=0)) Move sToken to ltTHLanguage.saScopeStart[iScopeStart] If ((sElement="SCOPEKEYWORDS")and(iList=1)) Move sToken to ltTHLanguage.saScopeStop[iScopeStop] If (sElement="KEYWORDS") Move sToken to ltTHLanguage.saKeywords[iKeyword] If (sElement="OPERATORS") Begin Move (Replace("<>", sToken, "<>")) to sToken Move (Replace("<", sToken, "<")) to sToken Move (Replace(">", sToken, ">")) to sToken Move (Replace("&", sToken, "&")) to sToken Move sToken to ltTHLanguage.saOperators[iOperator] End If ((sElement="RESOURCEBLOCK")and(iList=0)) Move sToken to ltTHLanguage.saScopeStart[iScopeStart] If ((sElement="RESOURCEBLOCK")and(iList=1)) Move sToken to ltTHLanguage.saScopeStop[iScopeStop] If ((sElement="STRINGS")and(iList=0)) Begin Move ltTHLanguage.sStringDelimiter to sStrings If (sStrings="") Move sToken to sStrings Else Move (sStrings+"\n"+sToken) to sStrings Move sStrings to ltTHLanguage.sStringDelimiter End // Get NextNode of hoToken to hoToken Loop Send Destroy to hoTokens End_Procedure Function LoadLanguage String sLanguage Returns tTHLanguage tTHLanguage ltTHLanguage String sVdfConfig String sPath String sFile String sValue Integer bOK Handle hoXML Handle hoRoot Handle hoTokenSet Handle hoTokens If ((Uppercase(sLanguage)="VDF")or(sLanguage="")) Move "DataFlex" to sLanguage If (Uppercase(sLanguage) contains "SQL") Move "SQL" to sLanguage Get psVdfRootDir of ghoWorkSpaceHandlerEx to sVdfConfig Get PathAtIndex of (phoWorkspace(ghoApplication)) sVdfConfig 1 to sPath Move (sPath+"\Lib\"+sLanguage+".lng") to sFile Get Create (RefClass(cXMLDOMDocument)) to hoXML If (hoXML) Begin Set psDocumentName of hoXML to sFile Get LoadXMLDocument of hoXML to bOK If (bOK) Begin Get DocumentElement of hoXML to hoRoot // Language If (hoRoot) Begin Move 1 to ltTHLanguage.iProcedural Get AttributeValueNS of hoRoot "" "name" to ltTHLanguage.sName Get AttributeValueNS of hoRoot "" "casesensitive" to sValue If (Uppercase(sValue)<>"NO") Move 1 to ltTHLanguage.iCaseSensitive Get FirstChild of hoRoot to hoTokenSet If hoTokenSet Begin While (hoTokenSet<>0) Get AttributeValueNS of hoTokenSet "" "id" to sValue Move (Uppercase(sValue)) to sValue // Token List 1 Get ChildElementNS of hoTokenSet "" "tokens" to hoTokens If hoTokens ; Send LoadLanguageTokens sLanguage sValue hoTokens 0 (<THLanguage) // Token List 2 Get ChildElementNS of hoTokenSet "" "tokens2" to hoTokens If hoTokens ; Send LoadLanguageTokens sLanguage sValue hoTokens 1 (<THLanguage) // Get NextNode of hoTokenSet to hoTokenSet Loop // hoTokenSet End Send Destroy to hoRoot End // hoRoot End // LoadXMLDocument OK Send Destroy of hoXML End // hoXML Function_Return ltTHLanguage End_Function Procedure THWorkspaceDataFlexDefaults String sHome Integer iExt tTHWorkspace THWorkspace // General Get pTHWorkspace of ghoApplication To THWorkspace Move "DataFlex" to THWorkspace.sSchema Get CurrentWorkSpaceDescription ; of ghoWorkSpaceHandlerEx to THWorkspace.sName // Folders Move sHome to THWorkspace.saFolders[0] // Files Move "SRC" to THWorkspace.saFiles[iExt] Move "DataFlex Project (Program)" to THWorkspace.saFileDesc[iExt] Increment iExt Move "PKG" to THWorkspace.saFiles[iExt] Move "DataFlex Package" to THWorkspace.saFileDesc[iExt] Increment iExt Move "INC" to THWorkspace.saFiles[iExt] Move "Include File" to THWorkspace.saFileDesc[iExt] Increment iExt Move "DD" to THWorkspace.saFiles[iExt] Move "Data Dictionary" to THWorkspace.saFileDesc[iExt] Increment iExt Move "MN" to THWorkspace.saFiles[iExt] Move "DataFlex Menu (obsolete)" to THWorkspace.saFileDesc[iExt] Increment iExt Move "H" to THWorkspace.saFiles[iExt] Move "Header" to THWorkspace.saFileDesc[iExt] Increment iExt Move "BP" to THWorkspace.saFiles[iExt] Move "DataFlex Business Process" to THWorkspace.saFileDesc[iExt] Increment iExt Move "UTL" to THWorkspace.saFiles[iExt] Move "Sture's Utility" to THWorkspace.saFileDesc[iExt] Increment iExt Move "DG" to THWorkspace.saFiles[iExt] Move "DataFlex Dialog" to THWorkspace.saFileDesc[iExt] Increment iExt Move "SL" to THWorkspace.saFiles[iExt] Move "DataFlex Selection List" to THWorkspace.saFileDesc[iExt] Increment iExt Move "VW" to THWorkspace.saFiles[iExt] Move "DataFlex View" to THWorkspace.saFileDesc[iExt] Increment iExt Move "RV" to THWorkspace.saFiles[iExt] Move "DataFlex Report View" to THWorkspace.saFileDesc[iExt] Increment iExt Move "WO" to THWorkspace.saFiles[iExt] Move "DataFlex Web Object" to THWorkspace.saFileDesc[iExt] Increment iExt Move "HTM" to THWorkspace.saFiles[iExt] Move "HyperText Markup Language" to THWorkspace.saFileDesc[iExt] Increment iExt Move "HTML" to THWorkspace.saFiles[iExt] Move "HyperText Markup Language" to THWorkspace.saFileDesc[iExt] Increment iExt Move "ASP" to THWorkspace.saFiles[iExt] Move "Active Server Page" to THWorkspace.saFileDesc[iExt] Increment iExt Move "JS" to THWorkspace.saFiles[iExt] Move "JavaScript" to THWorkspace.saFileDesc[iExt] Increment iExt Move "WS" to THWorkspace.saFiles[iExt] Move "DataFlex Workspace" to THWorkspace.saFileDesc[iExt] Increment iExt Move "SWS" to THWorkspace.saFiles[iExt] Move "DataFlex Studio Workspace" to THWorkspace.saFileDesc[iExt] Increment iExt Move "INI" to THWorkspace.saFiles[iExt] Move "Configuration File" to THWorkspace.saFileDesc[iExt] Increment iExt Move "CSS" to THWorkspace.saFiles[iExt] Move "Cascading Style Sheet" to THWorkspace.saFileDesc[iExt] Increment iExt Move "INT" to THWorkspace.saFiles[iExt] Move "Database Intermediate File" To THWorkspace.saFileDesc[iExt] Set pTHWorkspace of ghoApplication To THWorkspace End_Procedure Function THWorkspaceHome Returns String String sHome sPath String sWsFile sWSHome Number nVersion Get fnCurrentVdfVersion of ghoWorkSpaceHandlerEx to nVersion If (nVersion>=120) Begin Get CurrentHomePath of ghoWorkSpaceHandlerEx to sWSHome // usually a relative path such as "." or "..\" Get CurrentWSFile of ghoWorkSpaceHandlerEx to sWsFile Get ParseFolderName sWsFile to sPath Get ConvertRelativePath of ghoWorkSpaceHandlerEx sWSHome "." sPath To sHome End Else Begin Get PrimaryProgramPath of ghoWorkSpaceHandlerEx to sPath Get vParentPath sPath To sHome End Function_Return sHome End_Function Procedure THDoReadWorkspace String sWSFile Boolean bExists Integer bNew iType Integer iFFOptions String sFile sHome sDescription sFolder Handle hoWorkspace // String sVersion sSize sTmp Integer iFolder iFolders iFile iFiles iExclude iExcludes Integer iSize tTHWorkspace THWorkspace EmptyTHWorkspace // Get pTHWorkspace of ghoApplication To THWorkspace If (num_arguments>0) Move sWSFile to sFile If (sFile="") Begin // Assume it is DataFlex Project by Default Get THWorkspaceHome to sHome End Get vFolderFormat sHome To sHome Get THWorkspaceName sHome (&bNew) (&iType) to sFile // 1. Clear Repository Move EmptyTHWorkspace to THWorkspace // 2. Set Workspace (HWS) File Move (sHome+sFile) to THWorkspace.sFullName // 3. Read Options or Create HWS Template (if New) If (bNew) Begin Move 1 to THWorkspace.iShowPaths Set pTHWorkspace of ghoApplication To THWorkspace If (iType=1) Begin // DataFlex Defaults Send THWorkspaceDataFlexDefaults sHome End Send THDoWriteWorkspace End Else Begin // Read HWS file if found Direct_Input ("Binary:"*sHome+sFile) // Header Readln sVersion Move (Left(sVersion, 7)) to sVersion If (Left(sVersion, 3)<>"HWS") Begin Close_Input Send UserError ("File"*sHome+sFile*"is not a valid Hammer .hws file. Falling back to defaults.") Move 1 to THWorkspace.iShowPaths Set pTHWorkspace of ghoApplication To THWorkspace If (iType=1) Begin // DataFlex Defaults Send THWorkspaceDataFlexDefaults sHome End Procedure_Return // Not a HWS file End // General Get WSReadStr2 to THWorkspace.sName Get WSReadStr2 to THWorkspace.sSchema Get WSReadInt1 to THWorkspace.iShowPaths Get WSReadStr2 to THWorkspace.sStudio Get WSReadStr2 to THWorkspace.sCompiler Get WSReadStr2 to THWorkspace.sDBEditor Get WSReadStr2 to THWorkspace.sDBViewer // Folders Get WSReadInt2 to iFolders For iFolder from 0 to (iFolders-1) Get WSReadStr2 to sFolder If (iFolder=0) Begin // Check that our home folder hasn't changed //Get vFolderExists sFolder to bExists <-- Can't use this one as it depends on DIR: and thus opens its own channel and mucks this up completely Get vFilePathExists (sFolder+"*") to bExists If (bExists=false) Begin Move "" To sFolder End End Move sFolder To THWorkspace.saFolders[iFolder] Loop If (SizeOfArray(THWorkspace.saFolders)=0 Or THWorkspace.saFolders[0]="") Begin // if the user renames the folder then the logic can no longer find our home path Move sHome To THWorkspace.saFolders[0] // Put the home path of our workspace in there End // Files Get WSReadInt2 to iFiles For iFile from 0 to (iFiles-1) Get WSReadStr2 to THWorkspace.saFiles[iFile] Get WSReadStr2 to THWorkspace.saFileDesc[iFile] Loop // Excludes Get WSReadInt2 to iExcludes For iExclude from 0 to (iExcludes-1) Get WSReadStr2 to THWorkspace.saExclude[iExclude] Loop // Sources Get WSReadInt2 to iFiles For iFile from 0 to (iFiles-1) Get WSReadStr2 to THWorkspace.taSources[iFile].sFile Get WSReadStr4 to THWorkspace.taSources[iFile].sBookmarks Get WSReadInt2 to THWorkspace.taSources[iFile].iBookmarkCount Get WSReadInt2 to THWorkspace.taSources[iFile].iCursorColumn Get WSReadInt2 to THWorkspace.taSources[iFile].iCursorLine Loop // Find in Files Get WSReadStr2 to THWorkspace.sFFText Get WSReadStr2 to THWorkspace.sFFTypes Get WSReadStr2 to THWorkspace.sFFPath Get WSReadInt1 to THWorkspace.iFFMatchWord Get WSReadInt1 to THWorkspace.iFFMatchCase Get WSReadInt1 to THWorkspace.iFFSubFolders Get WSReadInt1 To iFFOptions // encoding the iFFShowAll and iFFExcludeComments into the same byte so // that I do not have to handle the versioning nightmare it will create otherwise. If (iFFOptions iAnd 1) Move 1 To THWorkspace.iFFShowAll If (iFFOptions iAnd 2) Move 1 To THWorkspace.iFFExcludeComments Get WSReadInt1 to THWorkspace.iFFRegExp // Opened Files Get WSReadInt2 to iFiles For iFile from 0 to (iFiles-1) Get WSReadStr2 to THWorkspace.saOpened[iFile] Loop Close_Input Set pTHWorkspace of ghoApplication To THWorkspace End End_Procedure // // During debugging I see bookmark/cursor position items in the taSources // arrays without a filename. Not sure why that can happen, but we don't want // to keep those as at has no value then. // Procedure RemoveEmptyBookmarkSources tTHSource[] ByRef taSources Integer iFile Integer iFiles String sFile Move (SizeOfArray(taSources)) to iFiles Move (iFiles-1) To iFile While (iFile>0) Move (trim(taSources[iFile].sFile)) to sFile If (sFile="") Begin Move (RemoveFromArray(taSources,iFile)) To taSources End Decrement iFile Loop End_Procedure Procedure THDoWriteWorkspace Integer iFolder iFolders iFile iFiles iExclude iExcludes Integer iFFOptions String sFile tTHWorkspace THWorkspace Get pTHWorkspace of ghoApplication To THWorkspace Send RemoveEmptyBookmarkSources (&THWorkspace.taSources) Move THWorkspace.sFullName To sFile Direct_Output sFile // Header Writeln "HWS0301, (C) 2018, KURANT Project" // Send WSWriteStr2 THWorkspace.sName Send WSWriteStr2 THWorkspace.sSchema Write (Character(THWorkspace.iShowPaths)) Send WSWriteStr2 THWorkspace.sStudio Send WSWriteStr2 THWorkspace.sCompiler Send WSWriteStr2 THWorkspace.sDBEditor Send WSWriteStr2 THWorkspace.sDBViewer // Folders Move (SizeOfArray(THWorkspace.saFolders)) to iFolders Write (SHORTtoBytes(iFolders)) For iFolder from 0 to (iFolders-1) Send WSWriteStr2 THWorkspace.saFolders[iFolder] Loop // Files Move (SizeOfArray(THWorkspace.saFiles)) to iFiles Write (SHORTtoBytes(iFiles)) For iFile from 0 to (iFiles-1) Send WSWriteStr2 THWorkspace.saFiles[iFile] Send WSWriteStr2 THWorkspace.saFileDesc[iFile] Loop // Excludes Move (SizeOfArray(THWorkspace.saExclude)) to iExcludes Write (SHORTtoBytes(iExcludes)) For iExclude from 0 to (iExcludes-1) Send WSWriteStr2 THWorkspace.saExclude[iExclude] Loop // File Information Move (SizeOfArray(THWorkspace.taSources)) to iFiles Write (SHORTtoBytes(iFiles)) For iFile from 0 to (iFiles-1) Send WSWriteStr2 THWorkspace.taSources[iFile].sFile Send WSWriteStr4 THWorkspace.taSources[iFile].sBookmarks Write (SHORTtoBytes(THWorkspace.taSources[iFile].iBookmarkCount)) Write (SHORTtoBytes(THWorkspace.taSources[iFile].iCursorColumn)) Write (SHORTtoBytes(THWorkspace.taSources[iFile].iCursorLine)) Loop // Find in Files Send WSWriteStr2 THWorkspace.sFFText Send WSWriteStr2 THWorkspace.sFFTypes Send WSWriteStr2 THWorkspace.sFFPath Write (Character(THWorkspace.iFFMatchWord)) // 0|1 Write (Character(THWorkspace.iFFMatchCase)) Write (Character(THWorkspace.iFFSubFolders)) Move 0 To iFFOptions If (THWorkspace.iFFShowAll) Move 1 To iFFOptions If (THWorkspace.iFFExcludeComments) Move (iFFOptions iOr 2) To iFFOptions Write (Character(iFFOptions)) Write (Character(THWorkspace.iFFRegExp)) // Opened Files Move (SizeOfArray(THWorkspace.saOpened)) to iFiles Write (SHORTtoBytes(iFiles)) For iFile from 0 to (iFiles-1) Send WSWriteStr2 THWorkspace.saOpened[iFile] Loop Close_Output End_Procedure // This Procedure should no longer be neccessary. // MK 27.06.2001 21:41 // This Procedure still required as TH3 loses standard DF packages visibility // SN 29.03.2017 13:12 Procedure AddToOpenPath String ByRef sOpenPath String ByRef sPath String sTmp If (sPath="") Procedure_Return If ((Pos(';', sPath)=0) and (Uppercase(sOpenPath) contains Uppercase(sPath))) Procedure_Return If (Pos(';', sPath)=0) Begin Move (sOpenPath+";"+sPath) to sOpenPath Procedure_Return End While (Pos(';', sPath)) Move (Left(sPath, Pos(';', sPath))) to sTmp Move (Replace(sTmp, sPath, "")) to sPath If (sTmp<>".;") ; Move (Replace(';', sTmp, "")) to sTmp If (not(Uppercase(sOpenPath) contains Uppercase(sTmp))) Begin If (sTmp=".;") ; Move (Replace(';', sTmp, "")) to sTmp Move (sOpenPath +';'+sTmp) to sOpenPath End Loop If (sPath<>"") Begin If (not(Uppercase(sOpenPath) contains Uppercase(sPath))) ; Move (sOpenPath + ";" + sPath) to sOpenPath End End_Procedure Procedure IncludeMakePath String sMake sMake2 sOpenPath Get_Attribute DF_OPEN_PATH to sOpenPath Get_Profile_String "DFCOMP" ; "MakePath" to sMake Send AddToOpenPath (&sOpenPath) (&sMake) Get_Profile_String "WorkSpaces" ; "SystemMakePath" to sMake2 Send AddToOpenPath (&sOpenPath) (&sMake2) Set_Attribute DF_OPEN_PATH to sOpenPath End_Procedure Send IncludeMakePath Procedure THRegisterDFClass tDFDefaultClasses[] ByRef ltDFClasses String sCategory String sClass String sPackage Integer iCount Move (SizeOfArray(ltDFClasses)) to iCount Move sCategory to ltDFClasses[iCount].sCategory Move sClass to ltDFClasses[iCount].sClass Move sPackage to ltDFClasses[iCount].sFile End_Procedure Procedure LoadDefaultClasses tDFDefaultClasses[] ByRef ltDFClasses Send THRegisterDFClass (<DFClasses) "DataDictionary" "DataDictionary" "DataDict.pkg" Send THRegisterDFClass (<DFClasses) "dbForm" "dbForm" "DFEntry.pkg" Send THRegisterDFClass (<DFClasses) "dbEdit" "cDbTextEdit" "cDbTextEdit.pkg" Send THRegisterDFClass (<DFClasses) "dbCombo" "dbComboForm" "DfCEntry.pkg" Send THRegisterDFClass (<DFClasses) "dbCheckBox" "dbCheckBox" "DFEnChk.pkg" Send THRegisterDFClass (<DFClasses) "dbSpinForm" "dbSpinForm" "DFSpnEnt.pkg" Send THRegisterDFClass (<DFClasses) "dbGrid" "dbGrid" "DfTable.pkg" Send THRegisterDFClass (<DFClasses) "dbList" "dbList" "DFSelLst.pkg" Send THRegisterDFClass (<DFClasses) "dbTabDialog" "dbTabDialog" "DfTabDlg.pkg" Send THRegisterDFClass (<DFClasses) "dbTabPage" "dbTabPage" "DfTabDlg.pkg" Send THRegisterDFClass (<DFClasses) "dbView" "dbView" "DFClient.pkg" Send THRegisterDFClass (<DFClasses) "dbModalPanel" "dbModalPanel" "DFClient.pkg" Send THRegisterDFClass (<DFClasses) "ReportView" "ReportView" "DFRptVw.pkg" Send THRegisterDFClass (<DFClasses) "cWinReport2" "cWinReport2" "cWinReport2.pkg" Send THRegisterDFClass (<DFClasses) "Button" "Button" "Windows.pkg" Send THRegisterDFClass (<DFClasses) "Radio" "Radio" "Windows.pkg" Send THRegisterDFClass (<DFClasses) "Form" "Form" "Windows.pkg" Send THRegisterDFClass (<DFClasses) "Group" "Group" "Windows.pkg" Send THRegisterDFClass (<DFClasses) "RadioGroup" "RadioGroup" "Windows.pkg" Send THRegisterDFClass (<DFClasses) "Menubar/toolbar System" "cCJCommandBarSystem" "cCJStandardCommandBarSystem.pkg" Send THRegisterDFClass (<DFClasses) "MenuItem" "cCJMenuItem" "cCJCommandBarSystem.pkg" Send THRegisterDFClass (<DFClasses) "cDbCJGrid" "cDbCJGrid" "cDbCJGrid.pkg" Send THRegisterDFClass (<DFClasses) "cDbCJGridColumn" "cDbCJGridColumn" "cDbCJGridColumn.pkg" Send THRegisterDFClass (<DFClasses) "cDbCJGridPromptList" "cDbCJGridPromptList" "cDbCJGridPromptList.pkg" Send THRegisterDFClass (<DFClasses) "cWebButton" "cWebButton" "cWebButton.pkg" Send THRegisterDFClass (<DFClasses) "cWebCheckBox" "cWebCheckBox" "cWebCheckBox.pkg" Send THRegisterDFClass (<DFClasses) "cWebCombo" "cWebCombo" "cWebCombo.pkg" Send THRegisterDFClass (<DFClasses) "cWebEdit" "cWebEdit" "cWebEdit.pkg" Send THRegisterDFClass (<DFClasses) "cWebForm" "cWebForm" "cWebForm.pkg" Send THRegisterDFClass (<DFClasses) "cWebGrid" "cWebGrid" "cWebGrid.pkg" Send THRegisterDFClass (<DFClasses) "cWebColumn" "cWebColumn" "cWebColumn.pkg" Send THRegisterDFClass (<DFClasses) "cWebColumnCheckBox" "cWebColumnCheckBox" "cWebColumnCheckBox.pkg" Send THRegisterDFClass (<DFClasses) "cWebColumnCombo" "cWebColumnCombo" "cWebColumnCombo.pkg" Send THRegisterDFClass (<DFClasses) "cWebMenuItem" "cWebMenuItem" "cWebMenuItem.pkg" Send THRegisterDFClass (<DFClasses) "cWebMenuItemLoadView" "cWebMenuItemLoadView" "cWebMenuItemLoadView.pkg" Send THRegisterDFClass (<DFClasses) "cWebModalDialog" "cWebModalDialog" "cWebModalDialog.pkg" Send THRegisterDFClass (<DFClasses) "cWebPanel" "cWebPanel" "cWebPanel.pkg" Send THRegisterDFClass (<DFClasses) "cWebPromptList" "cWebPromptList" "cWebPromptList.pkg" Send THRegisterDFClass (<DFClasses) "cWebTabContainer" "cWebTabContainer" "cWebTabContainer.pkg" Send THRegisterDFClass (<DFClasses) "cWebTabPage" "cWebTabPage" "cWebTabPage.pkg" Send THRegisterDFClass (<DFClasses) "cWebView" "cWebView" "cWebView.pkg" Send THRegisterDFClass (<DFClasses) "WebBusinessProcess" "cWebBusinessProcess" "cWebBusinessProcess.pkg" End_Procedure // Source File Function THWS_FindFile String sFile Returns Integer tTHSource ltaSource tTHWorkspace THWorkspace Move (Uppercase(sFile)) To ltaSource.sFile Get pTHWorkspace of ghoApplication To THWorkspace Function_Return (SearchArray(ltaSource, THWorkspace.taSources)) End_Function Function THWS_FileIndex String sFile Returns Integer tTHSource ltaSource tTHWorkspace THWorkspace Integer iFile Get pTHWorkspace of ghoApplication To THWorkspace Move sFile to ltaSource.sFile Move (SearchArray(ltaSource, THWorkspace.taSources)) to iFile If (iFile=-1) Move (SizeOfArray(THWorkspace.taSources)) to iFile Function_Return iFile End_Function Procedure THWS_SaveBookmarks String sFile String sBookmarks Integer iCount Integer iFile tTHWorkspace THWorkspace If ((iCount=0) and (sBookmarks<>"")) ; Move (Length(sBookmarks)/12) to iCount Move (Uppercase(Trim(sFile))) to sFile Get THWS_FileIndex sFile To iFile Get pTHWorkspace of ghoApplication To THWorkspace Move sFile to THWorkspace.taSources[iFile].sFile Move sBookmarks to THWorkspace.taSources[iFile].sBookmarks Move iCount To THWorkspace.taSources[iFile].iBookmarkCount Set pTHWorkspace of ghoApplication To THWorkspace End_Procedure Procedure THWS_SaveCursorPosition String sFile Integer iLine Integer iColumn Integer iFile tTHWorkspace THWorkspace Move (Uppercase(Trim(sFile))) to sFile Get THWS_FileIndex sFile To iFile Get pTHWorkspace of ghoApplication To THWorkspace Move sFile to THWorkspace.taSources[iFile].sFile Move iLine to THWorkspace.taSources[iFile].iCursorLine Move iColumn To THWorkspace.taSources[iFile].iCursorColumn Set pTHWorkspace of ghoApplication To THWorkspace End_Procedure // Opened files Procedure THWS_SaveOpened String sFile Handle hoEditor tTHWorkspace THWorkspace If (hoEditor<>0) Begin // also save bookmarks and CursorPositions Send SaveBookMarks of hoEditor sFile Send SaveCurrentPos of hoEditor sFile End Get pTHWorkspace of ghoApplication To THWorkspace If (SearchArray(sFile, THWorkspace.saOpened)<0) Begin Move sFile To THWorkspace.saOpened[SizeOfArray(THWorkspace.saOpened)] Set pTHWorkspace of ghoApplication To THWorkspace Send THDoWriteWorkspace End End_Procedure Procedure THWS_DeleteOpened String sFile Integer iFile tTHWorkspace THWorkspace Get pTHWorkspace of ghoApplication To THWorkspace Move (SearchArray(sFile, THWorkspace.saOpened)) to iFile If (iFile>=0) Begin Move (RemoveFromArray(THWorkspace.saOpened, iFile)) To THWorkspace.saOpened Set pTHWorkspace of ghoApplication To THWorkspace Send THDoWriteWorkspace End End_Procedure Function _T Global String sText Integer iIndex Returns String #IFDEF TH_TRANSLATION //@ RRS check iIndex against sizeofarray If (iIndex < SizeOfArray(gILanguage)) ; Move gILanguage[iIndex] to sText #ENDIF Function_Return sText End_Function