//AB/ Project System Info //AB/ Object oIDE_Project is a Dialog_Project //AB/ Set Size to 333 450 //AB/ Set ProjectName to "System Info" //AB/ Set ProjectFileName to "SysInfo.DG" //AB/ Set GenerateFileName to "NONAME1" // Project Object Structure // oSysInfo is a dbModalPanel // oOutput is a cFormattedOuptut // oWinTextBox1 is a cWinTextBox // oWinButton1 is a cWinButton // oWinButton2 is a cWinButton // oForm1 is a Form // oTreeView1 is a TreeView // oImageList is a cWinImageList // oWinListView1 is a cWinListView // oAppFiles is a Array // oAppName is a array // oAppValue is a array // oAppRegistry is a array // oRegistryKey is a cEnumRegistryKey // oSmallImages is a cSmallImageList // oSaveAsDialog1 is a SaveAsDialog // oVerticalSplitter1 is a cVerticalSplitter // Register all objects Register_Object oAppFiles Register_Object oAppName Register_Object oAppRegistry Register_Object oAppValue Register_Object oForm1 Register_Object oImageList Register_Object oOutput Register_Object oRegistryKey Register_Object oSaveAsDialog1 Register_Object oSmallImages Register_Object oSysInfo Register_Object oTreeView1 Register_Object oVerticalSplitter1 Register_Object oWinButton1 Register_Object oWinButton2 Register_Object oWinListView1 Register_Object oWinTextBox1 //AB-StoreTopStart Use DfClient.pkg Use cWinProcess.pkg Use cWinImageList.pkg Use cWinKeyboard.pkg Use cWinVolume.pkg Use cWinPlatform.pkg Use cWinSpoolEx.pkg Use cWinPathEx.pkg Use cSplitterControl.pkg Use cFormattedOutput.pkg Use cStatusPanel.pkg Use cEnumRegistryKey.pkg /CSS_TABLE_IMAGE h1 { font-family:Tahoma,Arial,sans-serif; letter-spacing:1pt; font-weight: bold; font-size:18pt; color: navy; border-bottom:1pt solid navy; width:80%; } h2 { color: #B00720; font-family:Tahoma,Arial,sans-serif; font-size: 16pt; font-weight: bold; padding-top: 10pt; padding-Left: 4pt; padding-bottom: 2pt; margin:0pt; } h3 { color: #555555; font-family:Tahoma,Arial,sans-serif; font-size: 14pt; font-weight: bold; padding-top: 10pt; padding-Left: 4pt; padding-bottom: 2pt; margin:0pt; } h4 { color: #555555; font-family:Tahoma,Arial,sans-serif; font-size: 12pt; font-weight: bold; padding-top: 6pt; padding-Left: 4pt; padding-bottom: 2pt; margin:0pt; } h5 { color: #555555; font-family:Tahoma,Arial,sans-serif; font-size: 10pt; font-weight: bold; padding-top: 6pt; padding-Left: 4pt; padding-bottom: 2pt; margin:0pt; } table { font-family: Tahoma,Arial,sans-serif; font-size: 10pt; color:gray; border:'1pt #E6E6E6 solid'; marging:0; padding:0; vertical-align:middle; width:80%; } .ListHeader { font-family: Tahoma,Arial,sans-serif; font-weight:normal; font-size: 10pt; color:#555555; border:'1pt #E6E6E6 solid'; background-color:#EAEAEA; marging:0; padding:0; vertical-align:middle; } .ListData { font-family: Tahoma,Arial,sans-serif; font-weight:normal; font-size: 8pt; color:black; border:'1pt #E6E6E6 solid'; background-color:white; marging:0; padding:0; vertical-align:middle; } p { font-family: Tahoma,Arial,sans-serif; font-weight:normal; font-size: 8pt; color:black; background-color:white; marging:0; padding:0; vertical-align:middle; } B.NOTE { font-family: Tahoma,Arial,sans-serif; color: Navy; } B.TIP { font-family: Tahoma,Arial,sans-serif; color: #FF8000; } P.NOTE { font-family: Tahoma,Arial,sans-serif; font-size: 10.0pt; margin-top: 15pt; margin-bottom: 15pt; background-color:#CCCCCC; border: 1 solid Navy; line-height: 15pt; width: 80%; } P.TIP { font-family: Tahoma,Arial,sans-serif; font-size: 10.0pt; margin-top: 15pt; margin-bottom: 15pt; background-color:#CCCCCC; border: 1 solid #FF8000; line-height: 15pt; width: 80%; } /* Define DESC_WIDTH For 40 Define rtiVDF For 1 Define tiRegistration For 101 Define tiWorkspace For 102 Define tiRuntime For 103 Define tiModules For 104 Define tiAttributes For 105 Define tiVariables For 106 Define tiConfig For 107 Define rtiDataBase For 2 Define tiDrivers For 201 Define tiDatafiles For 200000 Define tiFields For 210000 Define tiIndexes For 220000 Define tiLast For 299999 Define rtiSystem For 3 Define rtiUser For 301 Define rtiPaths For 302 Define tiAllUsers For 30201 Define tiCurrentUser For 30202 Define tiPathOther For 30203 Define rtiRegional For 303 Define tiCountry For 30301 Define tiLanguage For 30302 Define tiNumbers For 30303 Define tiCurrency For 30304 Define tiDate For 30305 Define tiTime For 30306 Define rtiMemory For 304 Define rtiHardware For 305 Define tiPrinters For 30501 Define tiDrives For 30502 Define tiMouse For 30503 Define tiKeyboard For 30504 Define rtiMetrics For 306 Define rtiApplication For 9 Define rtiAppRegistry For 901 Define rtiAppData For 902 //AB-StoreTopEnd //AB-IgnoreStart Use dfdbmdpn.pkg Use cWinTextBox.pkg Use cWinButton.pkg Use Windows.pkg Use DfTreeVw.pkg Use cWinListView.pkg Use File_dlg.Pkg //AB-IgnoreEnd Object oSysInfo is a dbModalPanel //AB-StoreTopStart // General Property String psSysInfoRevision Public "1.0.1 Beta" // // Output properties Property String psOutput Public "LIST" Property String psFile Public "" Property Integer piChannel Public 0 // Property String psTable Public "" // Set Locate_Mode To CENTER_ON_PANEL // // Formatted output Object oOutput Is A cFormattedOuptut End_Object // //AB-StoreTopEnd Set Border_Style To Border_Thick Set Maximize_Icon to TRUE Set Label to "System Info" Set Size to 238 418 Set Location to 2 4 Set peAnchors To anAll Set piMinSize to 238 418 //AB-DDOStart //AB-DDOEnd Object oWinTextBox1 is a cWinTextBox //AB-StoreTopStart Set peAnchors To anBottomRight //AB-StoreTopEnd Set Location to 223 265 Set Size to 8 56 Set TextColor to clNavy Set Gradient_Mode to GRADIENT_TOPBOTTOM Set GradientFromColor to clDkGray Set GradientToColor to clWhite Set FontSize to 32 0 Set FontWeight to 800 Set TypeFace to "Arial" Set Border_Style to BORDER_NORMAL Set Border_Color to clWhite Set pbAutoStatusHelpAsToolTip to FALSE //AB-StoreStart //AB-StoreEnd End_Object // oWinTextBox1 Object oWinButton1 is a cWinButton Set Location to 225 278 Set Size to 15 55 Set Color to 13492159 Set TextColor to 65793 Set Gradient_Mode to GRADIENT_TOPBOTTOM Set GradientFromColor to clWhite Set GradientToColor to clDkGray Set Label to "&Save" Set FontSize to 14 0 Set FontWeight to 800 Set TypeFace to "Arial" Set pbFlatState to TRUE Set Bitmap to "cWinButton.bmp" Set piBitmapAlign to BBA_LEFT Set psToolTip to "Save system information to TEXT, HTML or RTF format" Set psToolTipTitle to "Help" Set piToolTipIcon To TTI_INFO Set peAnchors to anBottomRight //AB-StoreStart Procedure OnClick Send DoCallSaveAsDialog To oSaveAsDialog1 End_Procedure // OnClick // The OnPaint message is sent when the system or another application makes // a request to paint a portion of an application's window. //Procedure OnPaint Integer hDC Integer iAct Integer iState // //End_Procedure // OnPaint // // The OnMouseMove message is posted to a window when the cursor moves. // If the mouse is not captured, the message is posted to the window that // contains the cursor. Otherwise, the message is posted to the window // that has captured the mouse. //Procedure OnMouseMove Integer iKeys Integer iXPos Integer iYPos // //End_Procedure // OnMouseMove // // The OnMouseLeave message is posted to a window when the cursor leaves // the client area of the window //Procedure OnMouseLeave // //End_Procedure // OnMouseLeave //AB-StoreEnd End_Object // oWinButton1 Object oWinButton2 is a cWinButton Set Location to 225 346 Set Size to 15 55 Set Color to 13492159 Set TextColor to 65793 Set Gradient_Mode to GRADIENT_TOPBOTTOM Set GradientFromColor to clWhite Set GradientToColor to clDkGray Set Label to "&Close" Set FontSize to 14 0 Set FontWeight to 800 Set TypeFace to "Arial" Set pbFlatState to TRUE Set Bitmap to "cWinButton.bmp" Set piBitmapAlign to BBA_LEFT Set psToolTip to "Close System Information dialog" Set psToolTipTitle to "Help" Set piToolTipIcon To TTI_INFO Set peAnchors to anBottomRight //AB-StoreStart Procedure OnClick Send Close_Panel End_Procedure // OnClick // The OnPaint message is sent when the system or another application makes // a request to paint a portion of an application's window. //Procedure OnPaint Integer hDC Integer iAct Integer iState // //End_Procedure // OnPaint // // The OnMouseMove message is posted to a window when the cursor moves. // If the mouse is not captured, the message is posted to the window that // contains the cursor. Otherwise, the message is posted to the window // that has captured the mouse. //Procedure OnMouseMove Integer iKeys Integer iXPos Integer iYPos // //End_Procedure // OnMouseMove // // The OnMouseLeave message is posted to a window when the cursor leaves // the client area of the window //Procedure OnMouseLeave // //End_Procedure // OnMouseLeave //AB-StoreEnd End_Object // oWinButton2 Object oForm1 is a Form Set Size to 1 1 Set Location to -100 -100 End_Object // oForm1 Object oTreeView1 is a TreeView //AB-StoreTopStart Set peAnchors To anTopBottom Object oImageList Is A cWinImageList Set piMaxImages To 80 Procedure OnCreate // add the images Integer iImage Get AddTransparentImage 'Sysinfo.bmp' clFuchsia To iImage End_Procedure End_Object Set ImageListObject To (oImageList(Self)) //AB-StoreTopEnd Set Size to 217 151 Set Location to 4 5 //AB-StoreStart // Function AddTreeItem String sLabel Integer hoRoot Integer iData Integer iImg1 Integer iImg2 Returns Handle Handle hRet String sOut Get psOutput To sOut If (sOut="LIST") Begin Forward Get AddTreeItem sLabel hoRoot iData iImg1 iImg2 To hRet End Else If (sOut="TXT") Begin Writeln If (iData<10) Begin Writeln (Uppercase(sLabel)) Writeln (Repeat('-', Length(sLabel))) End Else If (iData=tiDatafiles) Begin Writeln '* ' sLabel End Else If ((iData>tiFields)And(iData999) Writeln '- ' sLabel Writeln End Else Begin // New page on RTF for any new general branch If ((sOut="RTF")And(iData>1)And(iData<10)) Send mOutputTag To (oOutput(Self)) "RTFTAG" "" "" "{\page}" If (iData<10) Send mOutputTag To (oOutput(Self)) "TITLE" "HEADER 1" sLabel "" Else If (iData=tiDatafiles) Send mOutputTag To (oOutput(Self)) "TITLE" "HEADER 2" sLabel "" Else If ((iData>tiFields)And(iData<=tiIndexes)) Send mOutputTag To (oOutput(Self)) "TITLE" "HEADER 4" sLabel "" Else If ((iData>tiIndexes)And(iDatatiIndexes)And(iData999) Send mOutputTag To (oOutput(Self)) "TITLE" "HEADER 3" sLabel "" End If (sOut<>"LIST") Begin If (ghoStatusPanel) Send Update_StatusPanel Of ghoStatusPanel ("Processing"*sLabel+"...") Set psTable To "
" Send DoCreateList To (oWinListView1(Self)) iData sLabel End Function_Return hRet End_Function // Procedure OnCreateTree Send DoCreateTree End_Procedure // Procedure DoCreateTree Handle hItemRoot hItemChild hItemPaths hSubItemRoot Get AddTreeItem "Visual DataFlex" 0 rtiVDF 16 17 To hItemRoot Get AddTreeItem "Registration" hItemRoot tiRegistration 22 23 To hItemChild Get AddTreeItem "Workspace" hItemRoot tiWorkspace 18 19 To hItemChild Get AddTreeItem "Runtime files" hItemRoot tiRuntime 20 21 To hItemChild Get AddTreeItem "Module Names" hItemRoot tiModules 20 21 To hItemChild Get AddTreeItem "Global attributes" hItemRoot tiAttributes 22 23 To hItemChild Get AddTreeItem "Global variables" hItemRoot tiVariables 22 23 To hItemChild Get AddTreeItem "System Configuration" hItemRoot tiConfig 54 55 To hItemChild Get AddTreeItem "Database" 0 rtiDataBase 26 27 To hItemRoot Get AddTreeItem "Drivers" hItemRoot tiDrivers 44 45 To hItemChild Get AddTreeItem "Data files" hItemRoot tiDatafiles 28 29 To hItemChild Send DoCollectDataFiles hItemChild Get AddTreeItem "System" 0 rtiSystem 12 13 To hItemRoot Get AddTreeItem "User" hItemRoot rtiUser 38 39 To hItemChild Get AddTreeItem "Paths" hItemRoot rtiPaths 22 23 To hItemPaths Get AddTreeItem "All Users Profile" hItemPaths tiAllUsers 24 25 To hItemChild Get AddTreeItem "Current User Profile" hItemPaths tiCurrentUser 24 25 To hItemChild Get AddTreeItem "Other" hItemPaths tiPathOther 24 25 To hItemChild Get AddTreeItem "Regional settings" hItemRoot rtiRegional 56 57 To hItemPaths Get AddTreeItem "Country" hItemPaths tiCountry 54 55 To hItemChild Get AddTreeItem "Language" hItemPaths tiLanguage 54 55 To hItemChild Get AddTreeItem "Numbers" hItemPaths tiNumbers 54 55 To hItemChild Get AddTreeItem "Currency" hItemPaths tiCurrency 54 55 To hItemChild Get AddTreeItem "Date" hItemPaths tiDate 52 52 To hItemChild Get AddTreeItem "Time" hItemPaths tiTime 53 53 To hItemChild Get AddTreeItem "Memory" hItemRoot rtiMemory 40 41 To hItemChild Get AddTreeItem "Hardware" hItemRoot rtiHardware 12 13 To hSubItemRoot Get AddTreeItem "Printers" hSubItemRoot tiPrinters 60 60 To hItemChild Get AddTreeItem "Logical Drives" hSubItemRoot tiDrives 6 7 To hItemChild Get AddTreeItem "Mouse" hSubItemRoot tiMouse 10 11 To hItemChild Get AddTreeItem "Keyboard" hSubItemRoot tiKeyboard 8 9 To hItemChild Get AddTreeItem "System Metrics" hItemRoot rtiMetrics 54 55 To hSubItemRoot Get AddTreeItem "Application" 0 rtiApplication 50 51 To hItemRoot Get AddTreeItem "Registry" hItemRoot rtiAppRegistry 42 43 To hItemChild Get AddTreeItem "Data" hItemRoot rtiAppData 28 29 To hItemPaths End_Procedure // OnCreateTree Procedure DoCollectDataFiles Handle hItemRoot Handle hFile hItemChild hFields hIndexes Integer iData String sName Move 0 To hFile Repeat Get_Attribute DF_FILE_NEXT_USED Of hFile To hFile If (hFile>0) Begin Get_Attribute DF_FILE_DISPLAY_NAME Of hFile To sName Get AddTreeItem (String(hFile)*'-'*sName) hItemRoot (tiDatafiles+hFile) 28 29 To hItemChild Get AddTreeItem "Fields" hItemChild (tiFields+hFile) 32 33 To hFields Get AddTreeItem "Indexes" hItemChild (tiIndexes+hFile) 30 31 To hFields Send DoCollectFileIndexes hFields hFile End Until (hFile=0) End_Procedure Procedure DoCollectFileIndexes Handle hRoot Integer hFile Integer iOpen iClose hItem Integer iIndx iCnt iSegments Get_Attribute DF_FILE_OPENED Of hFile To iOpen If (Not(iOpen)) Begin Open hFile Move 1 To iClose End // Get_Attribute DF_FILE_LAST_INDEX_NUMBER Of hFile To iCnt For iIndx From 1 To iCnt Get_Attribute DF_INDEX_NUMBER_SEGMENTS Of hFile iIndx To iSegments If (iSegments) ; Get AddTreeItem ("Index."+String(iIndx)) hRoot (tiIndexes+hFile) 30 31 To hItem Loop // If (iClose) Close hFile End_Procedure //Procedure OnItemClick Handle hItem //End_Procedure Procedure OnItemChanged Handle hItem Integer iData iDyn Get ItemData hItem To iData Get Dynamic_Update_State Of oWinListView1 To iDyn Set Dynamic_Update_State Of oWinListView1 To False Send DoProcessData To oWinListView1 (Self) hItem iData Set Dynamic_Update_State Of oWinListView1 To iDyn End_Procedure Procedure OnRequestSplitter // Procedure_Return 1 End_Procedure Procedure OnSplitterChange Integer iTrack Set GuiSize To (Hi(GuiSize(Self))) (Low(GuiSize(Self))+iTrack) End_Procedure //AB-StoreEnd End_Object // oTreeView1 Object oWinListView1 is a cWinListView //AB-StoreTopStart Set peAnchors To anAll Object oAppFiles Is An Array End_Object Object oAppName Is An array End_Object Object oAppValue Is An array End_Object Object oAppRegistry Is An array End_Object // Registry Key enumerator Object oRegistryKey Is A cEnumRegistryKey End_Object Procedure Set piAppFile Integer iFile Integer iName Integer iValue Integer iItem Move (item_count(oAppFiles(Self))) To iItem Set Value Of (oAppFiles(Self)) Item iItem To iFile Set Value Of (oAppName(Self)) Item iItem To iName Set Value Of (oAppValue(Self)) Item iItem To iValue End_Procedure Function piAppFile Integer iItem Returns Integer Function_Return (Value(oAppFiles(Self),iItem)) End_Function Function piAppName Integer iItem Returns Integer Function_Return (Value(oAppName(Self),iItem)) End_Function Function piAppValue Integer iItem Returns Integer Function_Return (Value(oAppValue(Self),iItem)) End_Function Procedure Set psRegistryKey String sKey Set Value Of (oAppRegistry(Self)) Item (item_count(oAppRegistry(Self))) To sKey End_Procedure Function psRegistryKey Integer iItem Returns String Function_Return (Value(oAppRegistry(Self),iItem)) End_Function Open ORDSYS Open SALESP Set piAppFile ORDSYS.File_Number 0 To 0 Set piAppFile SALESP.File_Number 2 To 1 // VDF 7 //Set psRegistryKey To "Software\Data Access Corporation\Visual DataFlex\7\" // VDF 9 Set psRegistryKey To "Software\Data Access Worldwide\Visual DataFlex\9.0\IDE\" //AB-StoreTopEnd Set Size to 217 256 Set Location to 4 159 Set pbCheckBoxes to FALSE //AB-StoreStart Object oSmallImages Is A cSmallImageList Set piMaxImages To 80 Procedure OnCreate // add the images Integer iImage Get AddTransparentImage 'Sysinfo.bmp' clFuchsia To iImage End_Procedure End_Object Procedure OnCreate Set phSmallIL To (Window_Handle(oSmallImages(Self))) Send SI_VDF End_Procedure Procedure DoProcessData Integer hoTree Integer hItem Integer iData String sLabel Get ItemLabel Of hoTree hItem To sLabel Send DoCreateList iData sLabel End_Procedure Procedure DoCreateList Integer iData String sLabel String sOut Get psOutput To sOut If (sOut="LIST") Begin Send DoDeleteAllItems Send DoDeleteAllColumns End Else If (sOut="TEXT") Begin Writeln End // // VDF If (iData=rtiVdf) Send SI_Vdf If (iData=tiRegistration) Send SI_Regigistration If (iData=tiWorkspace) Send SI_Workspace If (iData=tiRuntime) Send SI_Runtime If (iData=tiModules) Send SI_Modules If (iData=tiAttributes) Send SI_Attributes If (iData=tiVariables) Send SI_Variables If (iData=tiConfig) Send SI_Config // Database If (iData=rtiDatabase) Send SI_Database If (iData=tiDrivers) Send SI_Drivers If (iData=tiDatafiles) Send SI_DataFiles If ((iData>tiDatafiles)And(iDatatiFields)And (iDatatiIndexes)And(iData") End_Procedure ////////////////////////////////////////////////////////////// // OUTPUT ////////////////////////////////////////////////////////////// Procedure AddPathColumns String sOut Get psOutput To sOut If (sOut="LIST") Begin Send DoInsertColumn "Description" 0 150 LVCFMT_LEFT Send DoInsertColumn "Full path" 1 150 LVCFMT_LEFT Send DoInsertColumn "Short path" 2 80 LVCFMT_LEFT End Else If (sOut="TXT") Begin Writeln Write "DESCRIPTION, " Write "FULL PATH, " Write "SHORT PATH" Writeln End Else Begin Set psTable To (psTable(Self)+"") End End_Procedure Procedure AddValueColumns Integer iOffSet String sLabel String sKey Integer iOff String sOut Get psOutput To sOut If (NUM_ARGUMENTS>0) Move iOffSet To iOff Else Move 0 To iOff If (NUM_ARGUMENTS>1) Move sLabel To sKey Else Move "Key" To sKey If (sOut="LIST") Begin Send DoInsertColumn sKey 0 (150+iOff) LVCFMT_LEFT Send DoInsertColumn "Value" 1 (230-iOff) LVCFMT_LEFT End Else If (sOut="TXT") Begin Writeln Write (Uppercase(sKey)) ", " Write "VALUE" Writeln End Else Begin Set psTable To (psTable(Self)+"") End End_Procedure Procedure AddPrinterColumns String sOut Get psOutput To sOut If (sOut="LIST") Begin Send DoInsertColumn "Printer name" 0 180 LVCFMT_LEFT Send DoInsertColumn "Port" 1 80 LVCFMT_LEFT Send DoInsertColumn "Share" 2 120 LVCFMT_LEFT End Else If (sOut="TXT") Begin Writeln Write "PRINTER NAME, " Write "PORT, " Write "SHARE" Writeln End Else Begin Set psTable To (psTable(Self)+"") End End_Procedure Procedure AddDriveColumns String sOut Get psOutput To sOut If (sOut="LIST") Begin Send DoInsertColumn "Drive" 0 50 LVCFMT_LEFT Send DoInsertColumn "Label" 1 80 LVCFMT_LEFT Send DoInsertColumn "Type" 2 50 LVCFMT_LEFT Send DoInsertColumn "Description" 3 200 LVCFMT_LEFT End Else If (sOut="TXT") Begin Writeln Write "DRIVE, " Write "LABEL, " Write "TYPE, " Write "DESCRIPTION" Writeln End Else Begin Set psTable To (psTable(Self)+"") End End_Procedure Procedure AddFilesColumns String sOut Get psOutput To sOut If (sOut="LIST") Begin Send DoInsertColumn "No." 0 50 LVCFMT_RIGHT Send DoInsertColumn "Logical" 1 80 LVCFMT_LEFT Send DoInsertColumn "Display" 2 150 LVCFMT_LEFT Send DoInsertColumn "Root" 3 100 LVCFMT_LEFT End Else If (sOut="TXT") Begin Writeln Write "NO., " Write "LOGICAL, " Write "DISPLAY, " Write "ROOT" Writeln End Else Begin Set psTable To (psTable(Self)+"") End End_Procedure Procedure AddDriversColumns String sOut Get psOutput To sOut If (sOut="LIST") Begin Send DoInsertColumn "Loaded drivers" 0 380 LVCFMT_LEFT End Else If (sOut="TXT") Begin Writeln Write "LOADED DRIVERS" Writeln End Else Begin Set psTable To (psTable(Self)+"") End End_Procedure Procedure AddFieldsColumns String sOut Get psOutput To sOut If (sOut="LIST") Begin Send DoInsertColumn "Name" 0 125 LVCFMT_LEFT Send DoInsertColumn "Type" 1 40 LVCFMT_LEFT Send DoInsertColumn "Length" 2 50 LVCFMT_RIGHT Send DoInsertColumn "Idx" 3 30 LVCFMT_RIGHT Send DoInsertColumn "Relation" 4 135 LVCFMT_LEFT End Else If (sOut="TXT") Begin Writeln Write "NAME, " Write "TYPE, " Write "LENGTH, " Write "IDX, " Write "RELATION" Writeln End Else Begin Set psTable To (psTable(Self)+"") End End_Procedure Procedure AddIndexColumns String sOut Get psOutput To sOut If (sOut="LIST") Begin Send DoInsertColumn "Name" 0 80 LVCFMT_LEFT Send DoInsertColumn "Segments" 1 65 LVCFMT_RIGHT Send DoInsertColumn "Type" 2 50 LVCFMT_LEFT Send DoInsertColumn "Levels" 3 50 LVCFMT_RIGHT Send DoInsertColumn "Key Length" 4 75 LVCFMT_RIGHT Send DoInsertColumn "Buffers" 5 60 LVCFMT_RIGHT End Else If (sOut="TXT") Begin Writeln Write "NAME, " Write "SEGMENTS, " Write "TYPE, " Write "LEVELS, " Write "KEY LENGTH, " Write "BUFFERS" Writeln End Else Begin Set psTable To (psTable(Self)+"") End End_Procedure Procedure AddEFileColumns String sOut Get psOutput To sOut If (sOut="LIST") Begin Send DoInsertColumn "File" 0 140 LVCFMT_LEFT Send DoInsertColumn "Date" 1 80 LVCFMT_LEFT Send DoInsertColumn "Size" 2 80 LVCFMT_RIGHT Send DoInsertColumn "Version" 3 80 LVCFMT_LEFT End Else If (sOut="TXT") Begin Writeln Write "FILE, " Write "DATE, " Write "SIZE, " Write "VERSION" Writeln End Else Begin Set psTable To (psTable(Self)+"") End End_Procedure Procedure AddIdxDataColumns String sOut Get psOutput To sOut If (sOut="LIST") Begin Send DoInsertColumn "Segment" 0 200 LVCFMT_LEFT Send DoInsertColumn "Case" 1 90 LVCFMT_LEFT Send DoInsertColumn "Direction" 2 90 LVCFMT_LEFT End Else If (sOut="TXT") Begin Writeln Write "Segment, " Write "Case, " Write "Direction" Writeln End Else Begin Set psTable To (psTable(Self)+"") End End_Procedure // Output Items Procedure AddEmptyItem Integer iRow String sOut Get psOutput To sOut If (sOut="LIST") Begin Get AddListItem "" 0 0 -1 -1 To iRow End Else If (sOut="TXT") Begin Writeln End Else Begin Set psTable To (psTable(Self)+"") End End_Procedure Procedure AddPathItem String sDesc String sPath Integer iRow String sOut sShort Get psOutput To sOut Move (GetShortPathName(sPath)) To sShort If (sOut="LIST") Begin Get AddListItem sDesc 0 0 22 0 To iRow Set ItemLabel iRow 1 To sPath Set ItemLabel iRow 2 To sShort End Else If (sOut="TXT") Begin Move (Left((sDesc+" "), DESC_WIDTH)) To sDesc Writeln sDesc " " sPath " " sShort End Else Begin If (sOut="RTF") Begin Move (Replaces("\",sPath,"?")) To sPath Move (Replaces("?",sPath,"\\")) To sPath Move (Replaces("\",sShort,"?")) To sShort Move (Replaces("?",sShort,"\\")) To sShort End Set psTable To (psTable(Self)+"") End End_Procedure Procedure AddValueItem String sName String sValue Integer iIcon Integer iRow String sOut sTemp Get psOutput To sOut If (sOut="LIST") Begin Get AddListItem sName 0 0 iIcon 0 To iRow Set ItemLabel iRow 1 To sValue End Else If (sOut="TXT") Begin Move (Left((sName+" "), DESC_WIDTH)) To sName Writeln sName sValue End Else Begin If (sOut="RTF") Begin Move (Replaces("\",sValue,"?")) To sValue Move (Replaces("?",sValue,"\\")) To sValue Move (Replaces("\",sName,"?")) To sName Move (Replaces("?",sName,"\\")) To sName End Set psTable To (psTable(Self)+"") End End_Procedure Procedure AddPrinterItem String sName String sPort String sShare Integer iIcon Integer iRow String sOut Get psOutput To sOut If (sOut="LIST") Begin Get AddListItem sName 0 0 iIcon 0 To iRow Set ItemLabel iRow 1 To sPort Set ItemLabel iRow 2 To sShare End Else If (sOut="TXT") Begin Move (Left((sName+" "), DESC_WIDTH)) To sName Write sName Write sPort " " Write sShare Writeln End Else Begin Set psTable To (psTable(Self)+"") End End_Procedure Procedure AddDriveItem String sDrive String sLabel String sType String sDesc Integer iIcon Integer iRow String sOut Get psOutput To sOut If (sOut="LIST") Begin Get AddListItem sDrive 0 0 iIcon 0 To iRow Set ItemLabel iRow 1 To sLabel Set ItemLabel iRow 2 To sType Set ItemLabel iRow 3 To sDesc End Else If (sOut="TXT") Begin Move (Left((sDrive+" "), DESC_WIDTH)) To sDrive Write sDrive Write sLabel ", " Write sType ", " Write sDesc ", " Writeln End Else Begin Set psTable To (psTable(Self)+"") End End_Procedure Procedure AddFilesItem String sFile String sLName String sDName String sRName Integer iRow String sOut Get psOutput To sOut If (sOut="LIST") Begin Get AddListItem sFile 0 0 28 0 To iRow Set ItemLabel iRow 1 To sLName Set ItemLabel iRow 2 To sDName Set ItemLabel iRow 3 To sRName End Else If (sOut="TXT") Begin Move (Left((sFile+" "), DESC_WIDTH)) To sFile Write sFile Write sLName ", " Write sDName ", " Write sRName Writeln End Else Begin Set psTable To (psTable(Self)+"") End End_Procedure Procedure AddDriverItem String sDriver Integer iRow String sOut Get psOutput To sOut If (sOut="LIST") Begin Get AddListItem sDriver 0 0 44 0 To iRow End Else If (sOut="TXT") Begin Writeln sDriver End Else Begin Set psTable To (psTable(Self)+"") End End_Procedure Procedure AddFieldsItem String sName String sType String iLength String iIdx String sRel Integer iRow String sOut Get psOutput To sOut If (sOut="LIST") Begin Get AddListItem sName 0 0 32 0 To iRow Set ItemLabel iRow 1 To sType Set ItemLabel iRow 2 To iLength Set ItemLabel iRow 3 To iIdx Set ItemLabel iRow 4 To sRel End Else If (sOut="TXT") Begin Move (Left((sName+" "), DESC_WIDTH)) To sName Write sName Write sType ", " Write iLength ", " Write iIdx ", " Write sRel Writeln End Else Begin Set psTable To (psTable(Self)+"") End End_Procedure Procedure AddIndexItem String sName String sSeg String sType String sLev String sKey String sBuf Integer iRow String sOut Get psOutput To sOut If (sOut="LIST") Begin Get AddListItem sName 0 0 30 0 To iRow Set ItemLabel iRow 1 To sSeg Set ItemLabel iRow 2 To sType Set ItemLabel iRow 3 To sLev Set ItemLabel iRow 4 To sKey Set ItemLabel iRow 5 To sBuf End Else If (sOut="TXT") Begin Move (Left((sName+" "), DESC_WIDTH)) To sName Write sName Write sSeg ", " Write sType ", " Write sLev ", " Write sKey ", " Write sBuf Writeln End Else Begin Set psTable To (psTable(Self)+"") End End_Procedure Procedure AddEFileItem String sFile String sDate String sSize String sVer Integer iRow String sOut Get psOutput To sOut If (sOut="LIST") Begin Get AddListItem sFile 0 0 44 0 To iRow Set ItemLabel iRow 1 To sDate Set ItemLabel iRow 2 To sSize Set ItemLabel iRow 3 To sVer End Else If (sOut="TXT") Begin Move (Left((sFile+" "), DESC_WIDTH)) To sFile Write sFile Write sDate ", " Write sSize ", " Write sVer Writeln End Else Begin Set psTable To (psTable(Self)+"") End End_Procedure Procedure AddIdxDataItem String sSeg String sCase String sDir Integer iRow String sOut Get psOutput To sOut If (sOut="LIST") Begin Get AddListItem sSeg 0 0 32 0 To iRow Set ItemLabel iRow 1 To sCase Set ItemLabel iRow 2 To sDir End Else If (sOut="TXT") Begin Move (Left((sSeg+" "), DESC_WIDTH)) To sSeg Write sSeg Write sCase ", " Write sDir Writeln End Else Begin Set psTable To (psTable(Self)+"") End End_Procedure ////////////////////////////////////////////////////////////// // END OF OUTPUT ////////////////////////////////////////////////////////////// Procedure SI_AppRegistry Integer iCount iItem iKey iKeys String sKey sName sData Send AddValueColumns Get Item_Count Of (oAppRegistry(Self)) To iCount If (iCount) Begin Decrement iCount For iItem From 0 To iCount Get psRegistryKey iItem To sKey If (sKey<>"") Begin Send DoEnumValue To (oRegistryKey(Self)) sKey Get Item_Count Of (oKey(oRegistryKey(Self))) To iKeys If (iKeys) Begin Decrement iKeys For iKey From 0 To iKeys Get Value Of (oKey(oRegistryKey(Self))) Item iKey To sName Get Value Of (oData(oRegistryKey(Self))) Item iKey To sData Send AddValueItem sName sData 58 Loop End End Loop End End_Procedure Procedure SI_User Send AddValueColumns Send AddValueItem "Current user name" (GetUserName()) 58 Send AddValueItem "Computer name" (GetComputerName()) 58 End_Procedure Procedure SI_AllUsers Send AddPathColumns Send AddPathItem "Profile" (GetAllUsersProfileDirectory()) Send AddPathItem "Desktop" (SHGetSpecialFolderPath(CSIDL_COMMON_DESKTOPDIRECTORY)) Send AddPathItem "Templates" (SHGetSpecialFolderPath(CSIDL_COMMON_TEMPLATES)) Send AddPathItem "Favorites" (SHGetSpecialFolderPath(CSIDL_COMMON_FAVORITES)) Send AddPathItem "Application Data" (SHGetSpecialFolderPath(CSIDL_COMMON_APPDATA)) Send AddPathItem "Common Documents" (SHGetSpecialFolderPath(CSIDL_COMMON_DOCUMENTS)) Send AddPathItem "Start Menu" (SHGetSpecialFolderPath(CSIDL_COMMON_STARTMENU)) Send AddPathItem "Start Menu Programs" (SHGetSpecialFolderPath(CSIDL_COMMON_PROGRAMS)) Send AddPathItem "Start Menu Programs Startup" (SHGetSpecialFolderPath(CSIDL_COMMON_STARTUP)) Send AddPathItem "Administrative Tools" (SHGetSpecialFolderPath(CSIDL_COMMON_ADMINTOOLS)) End_Procedure Procedure SI_CurrentUser Send AddPathColumns Send AddPathItem "Profile" (SHGetSpecialFolderPath(CSIDL_PROFILE)) Send AddPathItem "Desktop" (SHGetSpecialFolderPath(CSIDL_DESKTOPDIRECTORY)) Send AddPathItem "Templates" (SHGetSpecialFolderPath(CSIDL_TEMPLATES)) Send AddPathItem "Favorites" (SHGetSpecialFolderPath(CSIDL_FAVORITES)) Send AddPathItem "Recent files" (SHGetSpecialFolderPath(CSIDL_RECENT)) Send AddPathItem "Send To" (SHGetSpecialFolderPath(CSIDL_SENDTO)) Send AddPathItem "Network Places" (SHGetSpecialFolderPath(CSIDL_NETHOOD)) Send AddPathItem "Application Data" (SHGetSpecialFolderPath(CSIDL_APPDATA)) Send AddPathItem "PrintHood" (SHGetSpecialFolderPath(CSIDL_PRINTHOOD)) Send AddPathItem "Application Data" (SHGetSpecialFolderPath(CSIDL_LOCAL_APPDATA)) Send AddPathItem "Start menu" (SHGetSpecialFolderPath(CSIDL_STARTMENU)) Send AddPathItem "Start Menu Programs" (SHGetSpecialFolderPath(CSIDL_PROGRAMS)) Send AddPathItem "Start menu Programs Startup" (SHGetSpecialFolderPath(CSIDL_STARTUP)) Send AddPathItem "My Documents" (SHGetSpecialFolderPath(CSIDL_PERSONAL)) Send AddPathItem "My Pictures" (SHGetSpecialFolderPath(CSIDL_MYPICTURES)) Send AddPathItem "Internet Explorer Cache" (SHGetSpecialFolderPath(CSIDL_INTERNET_CACHE)) Send AddPathItem "Internet Explorer Cookies" (SHGetSpecialFolderPath(CSIDL_COOKIES)) Send AddPathItem "Internet Explorer History" (SHGetSpecialFolderPath(CSIDL_HISTORY)) End_Procedure Procedure SI_PathOther Send AddPathColumns Send AddPathItem "Desktop" (SHGetSpecialFolderPath(CSIDL_DESKTOP)) Send AddPathItem "Internet Explorer icon" (SHGetSpecialFolderPath(CSIDL_INTERNET)) Send AddPathItem "Control Panel" (SHGetSpecialFolderPath(CSIDL_CONTROLS)) Send AddPathItem "Printers" (SHGetSpecialFolderPath(CSIDL_PRINTERS)) Send AddPathItem "Recycle Bin" (SHGetSpecialFolderPath(CSIDL_BITBUCKET)) Send AddPathItem '"My Documents" desktop icon' (SHGetSpecialFolderPath(CSIDL_MYDOCUMENTS)) Send AddPathItem "My Music" (SHGetSpecialFolderPath(CSIDL_MYMUSIC)) Send AddPathItem "My Videos" (SHGetSpecialFolderPath(CSIDL_MYVIDEO)) Send AddPathItem "My Computer" (SHGetSpecialFolderPath(CSIDL_DRIVES)) Send AddPathItem "My Network Places" (SHGetSpecialFolderPath(CSIDL_NETWORK)) Send AddPathItem "Not Localized Startup" (SHGetSpecialFolderPath(CSIDL_ALTSTARTUP)) Send AddPathItem "Not Localized Common Startup" (SHGetSpecialFolderPath(CSIDL_COMMON_ALTSTARTUP)) Send AddPathItem "Current User Administrative Tools" (SHGetSpecialFolderPath(CSIDL_ADMINTOOLS)) Send AddPathItem "Network and Dial-up Connections" (SHGetSpecialFolderPath(CSIDL_CONNECTIONS)) Send AddPathItem "Common Music" (SHGetSpecialFolderPath(CSIDL_COMMON_MUSIC)) Send AddPathItem "Common Pictures" (SHGetSpecialFolderPath(CSIDL_COMMON_PICTURES)) Send AddPathItem "Common Videos" (SHGetSpecialFolderPath(CSIDL_COMMON_VIDEO)) Send AddPathItem "Resource Direcotry" (SHGetSpecialFolderPath(CSIDL_RESOURCES)) Send AddPathItem "Localized Resource Direcotry" (SHGetSpecialFolderPath(CSIDL_RESOURCES_LOCALIZED)) Send AddPathItem "Links to All Users OEM specific apps" (SHGetSpecialFolderPath(CSIDL_COMMON_OEM_LINKS)) Send AddPathItem "CD Burning Area" (SHGetSpecialFolderPath(CSIDL_CDBURN_AREA)) Send AddPathItem "Computers Near Me" (SHGetSpecialFolderPath(CSIDL_COMPUTERSNEARME)) // End_Procedure Procedure SI_Paths Send AddPathColumns Send AddPathItem "Windows directory" (GetWindowsDirectory()) Send AddPathItem "System directory" (GetSystemDirectory()) Send AddPathItem "Windows Fonts" (SHGetSpecialFolderPath(CSIDL_FONTS)) Send AddPathItem "Program Files" (SHGetSpecialFolderPath(CSIDL_PROGRAM_FILES)) Send AddPathItem "Common Program Files" (SHGetSpecialFolderPath(CSIDL_PROGRAM_FILES_COMMON)) Send AddPathItem "Current directory" (GetCurrentDirectory()) Send AddPathItem "Temporary Path" (GetLongPathName(GetTempPath())) Send AddPathItem "Profiles" (GetProfilesDirectory()) Send AddPathItem "Default User Profile" (GetDefaultUserProfileDirectory()) End_Procedure Procedure SI_Application Send AddValueColumns #IF (!@<80) Send AddValueItem "Program name" "" 58 Send AddValueItem "Current revision" "" 58 Send AddValueItem "Product name" "" 58 Send AddValueItem "Company name" "" 58 #ELSE If (ghoApplication <> 0) Begin Send AddValueItem "Program name" (psProgram(ghoApplication)) 58 Send AddValueItem "Current revision" (psVersion(ghoApplication)) 58 Send AddValueItem "Product name" (psProduct(ghoApplication)) 58 Send AddValueItem "Company name" (psCompany(ghoApplication)) 58 End #ENDIF End_Procedure Procedure SI_Printers Integer hoPrn hoPrinter iPrinter iPrinters iIcon Integer iShared iDefault String sName sServer sPort sShare Send AddPrinterColumns Get Create U_cWinPrinters To hoPrn If (hoPrn) Begin Send DoEnumPrinters To hoPrn Get Item_Count Of hoPrn To iPrinters If (iPrinters) Begin For iPrinter From 0 To (iPrinters-1) Get Value Of hoPrn Item iPrinter To hoPrinter If (hoPrinter) Begin Get Value Of hoPrinter Item Printer_Enum_bDefault To iDefault Get Value Of hoPrinter Item Printer_Enum_bShared To iShared Move 61 To iIcon If (iDefault) Move 64 To iIcon If (iShared) Move 62 To iIcon If ((iDefault)And(iShared)) Move 63 To iIcon // Get Value Of hoPrinter Item Printer_Enum_PrinterName To sName If (SWAPathIsNetworkPath(sName)) Begin Move (SWAPathRemoveFileSpec(sName)) To sServer Move (Replace(sServer, sName, "")) To sName Move (Replace('\\', sServer, "")) To sServer Move (Replace('\', sName, "")) To sName Move (sName*"on"*sServer) To sName End Get Value Of hoPrinter Item Printer_Enum_PortName To sPort Get Value Of hoPrinter Item Printer_Enum_ShareName To sShare Send AddPrinterItem sName sPort sShare iIcon End Loop End // Send Delete_Data To hoPrn Send Destroy To hoPrn End End_Procedure Procedure SI_VDF Integer iVersionMajor iVersionMinor iVersionRelease String sName // Send AddValueColumns // Version_Information iVersionMajor iVersionMinor iVersionRelease Get_Profile_String "" "CurrentVersionDescription" To sName Send AddValueItem "Visual Dataflex Name" sName 58 Send AddValueItem "Visual Dataflex Revision" (String (iVersionMajor) - "." - String (iVersionMinor) - "." - String (iVersionRelease)) 58 Send AddValueItem "Package version" (String (PKG_VERSION) - "." - String (PKG_REVISION) - "." - String (PKG_BUILD)) 58 Send AddValueItem "FMAC version" (String (FMAC_VERSION) - "." - String (FMAC_REVISION) - "." - String (FMAC_BUILD)) 58 GET_CURRENT_USER_COUNT To sName Send AddValueItem "Current user count" sName 58 // End_Procedure Procedure SI_Metrics Integer iVal // Send AddValueColumns // Send AddValueItem "Video resolution" (String(GetSystemMetrics(SM_CXSCREEN))*'x'*String(GetSystemMetrics(SM_CYSCREEN))) 58 Send AddValueItem "Virtual screen size" (String(GetSystemMetrics(SM_CXVIRTUALSCREEN))*'x'*String(GetSystemMetrics(SM_CYVIRTUALSCREEN))) 58 Send AddValueItem "Size of arrow bitmap (H scroll)" (String(GetSystemMetrics(SM_CXHSCROLL))*'x'*String(GetSystemMetrics(SM_CYHSCROLL))*"px") 58 Send AddValueItem "Size of arrow bitmap (V scroll)" (String(GetSystemMetrics(SM_CXVSCROLL))*'x'*String(GetSystemMetrics(SM_CYVSCROLL))*"px") 58 Send AddValueItem "Cursor size" (String(GetSystemMetrics(SM_CXCURSOR))*'x'*String(GetSystemMetrics(SM_CYCURSOR))*"px") 58 Send AddValueItem "Windows client area size" (String(GetSystemMetrics(SM_CXFULLSCREEN))*'x'*String(GetSystemMetrics(SM_CYFULLSCREEN))*"px") 58 Send AddValueItem "Height of caption bar" (String(GetSystemMetrics(SM_CYCAPTION))*"px") 58 Send AddValueItem "Title bar bitmap size" (String(GetSystemMetrics(SM_CXSIZE))*'x'*String(GetSystemMetrics(SM_CYSIZE))*"px") 58 Move (GetSystemMetrics(SM_DEBUG)) To iVal Send AddValueItem "Debug version of USER.EXE" (If(iVal, "Yes", "No")) 58 Move (String(GetSystemMetrics(SM_REMOTESESSION))) To iVal Send AddValueItem "Terminal Services remote session" (If(iVal, "Yes", "No")) 58 Move (GetSystemMetrics(SM_SECURE)) To iVal Send AddValueItem "Security enabled" (If(iVal, "Yes", "No")) 58 Move (String(GetSystemMetrics(SM_NETWORK) Iand |CI00000001)) To iVal Send AddValueItem "Network found" (If(iVal, "Yes", "No")) 58 Move (GetSystemMetrics(SM_CLEANBOOT)) To iVal Send AddValueItem "Current boot mode" (If(iVal=0, "Normal", If (iVal=1, "Fail safe", "Fail safe with Network"))) 58 Send AddValueItem "Number of monitors installed" (String(GetSystemMetrics(SM_CMONITORS))) 58 Move (String(GetSystemMetrics(SM_SLOWMACHINE))) To iVal Send AddValueItem "Slow machine" (If(iVal, "Yes", "No")) 58 // End_Procedure Procedure SI_System Integer hoPlatform iVal String sName // Send AddValueColumns // Get Create U_cWinPlatform To hoPlatform If (hoPlatform) Begin Send DoSetOSPropertiesEx To hoPlatform // Send AddValueItem "O/S Name" (psOSVersion(hoPlatform)) 58 Send AddValueItem "O/S Service Pack" (psServicePack(hoPlatform)) 58 Move (psSuite(hoPlatform)) To sName If (sName="") Move "N/A" To sName Send AddValueItem "O/S Suite" sName 58 Send AddValueItem "O/S Major number" (piMajorVersion(hoPlatform)) 58 Send AddValueItem "O/S Minor number" (piMinorVersion(hoPlatform)) 58 Send AddValueItem "O/S Build number" (piBuildNumber(hoPlatform)) 58 Send AddValueItem "O/S Service Pack major number" (piServicePackMajor(hoPlatform)) 58 Send AddValueItem "O/S Service Pack minor number" (piServicePackMinor(hoPlatform)) 58 Move (pbNTServer(hoPlatform)) To iVal Send AddValueItem "O/S is NT Server" (If(iVal, "Yes", "No")) 58 Move (pbWindowsHome(hoPlatform)) To iVal Send AddValueItem "O/S is home edition" (If(iVal, "Yes", "No")) 58 // Send Destroy To hoPlatform End End_Procedure Procedure SI_Config Integer iTime String sName // Send AddValueColumns // Send AddValueItem "Time events per second" (SysConf(SYSCONF_TIMER_RESOLUTION)) 58 Move (SysConf(SYSCONF_DIR_SEPARATOR)) To sName Move (sName*'('+String(Ascii(sName))+')') To sName Send AddValueItem "Directory separator" sName 58 Send AddValueItem "O/S Short name" (SysConf(SYSCONF_OS_SHORT_NAME)) 58 Send AddValueItem "O/S Major revision" (SysConf(SYSCONF_OS_MAJOR_REV)) 58 Send AddValueItem "O/S Minor revision" (SysConf(SYSCONF_OS_MINOR_REV)) 58 Send AddValueItem "O/S Name" (SysConf(SYSCONF_OS_NAME)) 58 Send AddValueItem "Wildcard search mask" (SysConf(SYSCONF_FILE_MASK)) 58 Send AddValueItem "Current dataflex revision" (SysConf(SYSCONF_DATAFLEX_REV)) 58 Send AddValueItem "System specific name" (SysConf(SYSCONF_SYSTEM_NAME)) 58 Move (SysConf(SYSCONF_PATH_SEPARATOR)) To sName Move (sName*'('+String(Ascii(sName))+')') To sName Send AddValueItem "Path separator" sName 58 Send AddValueItem "Runtime name" (SysConf(SYSCONF_RUNTIME_NAME)) 58 Move (SysConf(SYSCONF_UTC_TIME_OFFSET)) To iTime Move (String(iTime/3600)*'h') To sName Send AddValueItem "UTS Time offset" sName 58 // End_Procedure Procedure SI_Mouse Integer iMouse // Send AddValueColumns // Move (GetSystemMetrics(SM_MOUSEPRESENT)) To iMouse Send AddValueItem "Mouse found" (If(iMouse, "Yes", "No")) 10 If (iMouse) Begin Send AddValueItem "Double click time" (String(GetDoubleClickTimeEf())*"ms") 10 Send AddValueItem "Mouse wheel found" (If(GetSystemMetrics(SM_MOUSEWHEELPRESENT), "Yes", "No")) 10 Send AddValueItem "Number of mouse buttons" (String(GetSystemMetrics(SM_CMOUSEBUTTONS))) 10 Send AddValueItem "Mouse buttons are swapped" (If(GetSystemMetrics(SM_SWAPBUTTON), "Yes", "No")) 10 End // End_Procedure Procedure SI_Drives Integer iRow iDrive iType ihImg ilImg hoVolume String sName sID sType sNet sFS sLabel String sServer sRDir // Send AddDriveColumns // Move (GetLogicalDriveName()) To sName Get Create U_cWinVolumeInfo To hoVolume For iDrive From 1 To (Length(sName)) Move (Mid(sName, 3, iDrive)) To sId Set Volume_Root Of hoVolume To sID If (pbReady(hoVolume)) Begin Get piType Of hoVolume To iType Get psType Of hoVolume To sType Get psFileSystem Of hoVolume To sFs Get Label Of hoVolume To sLabel Get psConnectionName Of hoVolume To sNet End // Move (Left(sID,2)) To sID If (iType=DRIVE_UNKNOWN) Move 6 To ihImg If (iType=DRIVE_NO_ROOT_DIR) Move 6 To ihImg If (iType=DRIVE_REMOVABLE) Move 36 To ihImg If ((iType=DRIVE_REMOVABLE)And("AB" Contains Left(sID, 1))) Move 4 To ihImg If (iType=DRIVE_FIXED) Move 2 To ihImg If (iType=DRIVE_REMOTE) Begin Move 34 To ihImg If (sNet<>"") Begin If (SWAPathIsNetworkPath(sNet)) Begin Move (SWAPathRemoveFileSpec(sNet)) To sServer Move (Replace(sServer, sNet, "")) To sNet Move (Replace('\\', sServer, "")) To sServer Move (Replace('\', sNet, "")) To sNet Move (Lowercase(sNet)*"on '"+sServer+"'") To sType End Else Move (sType*'"'+sNet+'"') To sType End End If (iType=DRIVE_CDROM) Move 0 To ihImg If (iType=DRIVE_RAMDISK) Move 6 To ihImg Send AddDriveItem sID sLabel sFS sType ihImg // Move (iDrive + 3) To iDrive Loop If (hoVolume) Send Destroy To hoVolume // End_Procedure Procedure SI_Regigistration String sRegName Number SerialNo // Send AddValueColumns // Registration sRegName SerialNo Send AddValueItem "Serial number" SerialNo 14 Send AddValueItem "Registration name" sRegName 14 // End_Procedure Procedure SI_Memory String sMemory Pointer lpMemory Integer iRet iMemAvail Integer iMemoryLoad iTotalPhys iAvailPhys iTotalPageFile iAvailPageFile iTotalVirtual iAvailVirtual // Send AddValueColumns // ZeroType WIN_MEMORYSTATUS To sMemory Put WIN_MEMORYSTATUS_Size To sMemory At WIN_MEMORYSTATUS.dwLength GetAddress Of sMemory To lpMemory Move (GlobalMemoryStatusEf(lpMemory)) To iRet GetBuff From sMemory At WIN_MEMORYSTATUS.dwMemoryLoad To iMemoryLoad GetBuff From sMemory At WIN_MEMORYSTATUS.dwTotalPhys To iTotalPhys GetBuff From sMemory At WIN_MEMORYSTATUS.dwAvailPhys To iAvailPhys GetBuff From sMemory At WIN_MEMORYSTATUS.dwTotalPageFile To iTotalPageFile GetBuff From sMemory At WIN_MEMORYSTATUS.dwAvailPageFile To iAvailPageFile GetBuff From sMemory At WIN_MEMORYSTATUS.dwTotalVirtual To iTotalVirtual GetBuff From sMemory At WIN_MEMORYSTATUS.dwAvailVirtual To iAvailVirtual Memory iMemAvail Send AddValueItem "Current memory utilization" (String(iMemoryLoad)*'%') 40 Send AddValueItem "Total physical memory" (String(Round(iTotalPhys/(1024*1024)))*"MB") 40 Send AddValueItem "Available physical memory" (String(Round(iAvailPhys/(1024*1024)))*'MB ('+String(Round(iAvailPhys/iTotalPhys*100.0))+'%)') 40 Send AddValueItem "Total pagefile space" (String(Round(iTotalPageFile/(1024*1024)))*"MB") 40 Send AddValueItem "Available pagefile space" (String(Round(iAvailPageFile/(1024*1024)))*'MB ('+String(Round(iAvailPageFile/iTotalPageFile*100.0))+'%)') 40 Send AddValueItem "Total virtual memory" (String(Round(iTotalVirtual/(1024*1024)))*"MB") 40 Send AddValueItem "Available virtual memory" (String(Round(iAvailVirtual/(1024*1024)))*'MB ('+String(Round(iAvailVirtual/iTotalVirtual*100.0))+'%)') 40 Send AddValueItem "Available Memory" (String(Round(iMemAvail/(1024*1024)))*"MB") 40 // End_Procedure Procedure SI_Date String sName // Send AddValueColumns // Send AddValueItem "Current calendar type ID" (WindowsLocale(LOCALE_ICALENDARTYPE, 2)) 52 Send AddValueItem "Current calendar name" (WindowsCalendarName()) 52 Send AddValueItem "Windows epoch value" (GetCalendarInfo (LOCALE_USER_DEFAULT, WindowsLocale(LOCALE_ICALENDARTYPE, 2), CAL_ITWODIGITYEARMAX)) 52 Send AddValueItem "Date separator" (WindowsLocale(LOCALE_SDATE, 2)*'('+String(Ascii(WindowsLocale(LOCALE_SDATE, 2)))+')') 52 Send AddValueItem "Year/Month format" (WindowsLocale(LOCALE_SYEARMONTH, 10)) 52 Send AddValueItem "Short date format" (WindowsLocale(LOCALE_SSHORTDATE, 25)) 52 Send AddValueItem "Long date format" (WindowsLocale(LOCALE_SLONGDATE, 50)) 52 // Move (WindowsLocale(LOCALE_IDATE, 2)) To sName If (sName="0") Move "Month-Day-Year" To sName Else If (sName="1") Move "Day-Month-Year" To sName Else If (sName="2") Move "Year-Month-Day" To sName Send AddValueItem "Short date format-ordering" sName 52 // Move (WindowsLocale(LOCALE_ILDATE, 2)) To sName If (sName="0") Move "Month-Day-Year" To sName Else If (sName="1") Move "Day-Month-Year" To sName Else If (sName="2") Move "Year-Month-Day" To sName Send AddValueItem "Long date format-ordering" sName 52 // Send AddValueItem "Full 4 digit century" (If(WindowsLocale(LOCALE_ICENTURY, 2)="1", "Yes", "No")) 52 Send AddValueItem "Use leading zeroes in day fields" (If(WindowsLocale(LOCALE_IDAYLZERO, 2)="1", "Yes", "No")) 52 Send AddValueItem "Use leading zeroes in month fields" (If(WindowsLocale(LOCALE_IMONLZERO, 2)="1", "Yes", "No")) 52 Send AddValueItem "The first day in a week" (GetLongDayName(WindowsLocale(LOCALE_IFIRSTDAYOFWEEK, 2))) 52 // Move (WindowsLocale(LOCALE_IFIRSTWEEKOFYEAR, 2)) To sName If (sName="0") Move "Week containing 1/1 is the first week" To sName Else If (sName="1") Move "First full week following 1/1 is the first week" To sName Else If (sName="2") Move "First week containing at least four days" To sName Send AddValueItem "The first week of the year" sName 52 // Send AddEmptyItem // Send AddValueItem "Day 1 name" (ToOem(WindowsLocale(LOCALE_SDAYNAME1, 25))*'('+ToOem(WindowsLocale(LOCALE_SABBREVDAYNAME1, 25))+')') 52 Send AddValueItem "Day 2 name" (ToOem(WindowsLocale(LOCALE_SDAYNAME2, 25))*'('+ToOem(WindowsLocale(LOCALE_SABBREVDAYNAME2, 25))+')') 52 Send AddValueItem "Day 3 name" (ToOem(WindowsLocale(LOCALE_SDAYNAME3, 25))*'('+ToOem(WindowsLocale(LOCALE_SABBREVDAYNAME3, 25))+')') 52 Send AddValueItem "Day 4 name" (ToOem(WindowsLocale(LOCALE_SDAYNAME4, 25))*'('+ToOem(WindowsLocale(LOCALE_SABBREVDAYNAME4, 25))+')') 52 Send AddValueItem "Day 5 name" (ToOem(WindowsLocale(LOCALE_SDAYNAME5, 25))*'('+ToOem(WindowsLocale(LOCALE_SABBREVDAYNAME5, 25))+')') 52 Send AddValueItem "Day 6 name" (ToOem(WindowsLocale(LOCALE_SDAYNAME6, 25))*'('+ToOem(WindowsLocale(LOCALE_SABBREVDAYNAME6, 25))+')') 52 Send AddValueItem "Day 7 name" (ToOem(WindowsLocale(LOCALE_SDAYNAME7, 25))*'('+ToOem(WindowsLocale(LOCALE_SABBREVDAYNAME7, 25))+')') 52 // Send AddEmptyItem // Send AddValueItem "Month 1 name" (ToOem(WindowsLocale(LOCALE_SMONTHNAME1, 25))*'('+ToOem(WindowsLocale(LOCALE_SABBREVMONTHNAME1, 25))+')') 52 Send AddValueItem "Month 2 name" (ToOem(WindowsLocale(LOCALE_SMONTHNAME2, 25))*'('+ToOem(WindowsLocale(LOCALE_SABBREVMONTHNAME2, 25))+')') 52 Send AddValueItem "Month 3 name" (ToOem(WindowsLocale(LOCALE_SMONTHNAME3, 25))*'('+ToOem(WindowsLocale(LOCALE_SABBREVMONTHNAME3, 25))+')') 52 Send AddValueItem "Month 4 name" (ToOem(WindowsLocale(LOCALE_SMONTHNAME4, 25))*'('+ToOem(WindowsLocale(LOCALE_SABBREVMONTHNAME4, 25))+')') 52 Send AddValueItem "Month 5 name" (ToOem(WindowsLocale(LOCALE_SMONTHNAME5, 25))*'('+ToOem(WindowsLocale(LOCALE_SABBREVMONTHNAME5, 25))+')') 52 Send AddValueItem "Month 6 name" (ToOem(WindowsLocale(LOCALE_SMONTHNAME6, 25))*'('+ToOem(WindowsLocale(LOCALE_SABBREVMONTHNAME6, 25))+')') 52 Send AddValueItem "Month 7 name" (ToOem(WindowsLocale(LOCALE_SMONTHNAME7, 25))*'('+ToOem(WindowsLocale(LOCALE_SABBREVMONTHNAME7, 25))+')') 52 Send AddValueItem "Month 8 name" (ToOem(WindowsLocale(LOCALE_SMONTHNAME8, 25))*'('+ToOem(WindowsLocale(LOCALE_SABBREVMONTHNAME8, 25))+')') 52 Send AddValueItem "Month 9 name" (ToOem(WindowsLocale(LOCALE_SMONTHNAME9, 25))*'('+ToOem(WindowsLocale(LOCALE_SABBREVMONTHNAME9, 25))+')') 52 Send AddValueItem "Month 10 name" (ToOem(WindowsLocale(LOCALE_SMONTHNAME10, 25))*'('+ToOem(WindowsLocale(LOCALE_SABBREVMONTHNAME10, 25))+')') 52 Send AddValueItem "Month 11 name" (ToOem(WindowsLocale(LOCALE_SMONTHNAME11, 25))*'('+ToOem(WindowsLocale(LOCALE_SABBREVMONTHNAME11, 25))+')') 52 Send AddValueItem "Month 12 name" (ToOem(WindowsLocale(LOCALE_SMONTHNAME12, 25))*'('+ToOem(WindowsLocale(LOCALE_SABBREVMONTHNAME12, 25))+')') 52 Move (ToOem(WindowsLocale(LOCALE_SMONTHNAME13, 25))*'('+ToOem(WindowsLocale(LOCALE_SABBREVMONTHNAME13, 25))+')') To sName If (sName<>"()") ; Send AddValueItem "Month 13 name" sName 52 // End_Procedure Procedure SI_Time Send AddValueColumns Send AddValueItem "Time separator" (WindowsLocale(LOCALE_STIME, 2)*'('+String(Ascii(WindowsLocale(LOCALE_STIME, 2)))+')') 53 Send AddValueItem "Time format" (WindowsLocale(LOCALE_STIMEFORMAT, 100)) 53 Send AddValueItem "Period format" (WindowsLocale(LOCALE_ITIME, 2)) 53 Send AddValueItem "Marker position" (WindowsLocale(LOCALE_ITIMEMARKPOSN, 2)) 53 Send AddValueItem "Use leading zeroes" (WindowsLocale(LOCALE_ITLZERO, 2)) 53 Send AddValueItem "AM symbol" (WindowsLocale(LOCALE_S1159, 10)) 53 Send AddValueItem "PM Symbol" (WindowsLocale(LOCALE_S2359, 10)) 53 End_Procedure Procedure SI_Language Send AddValueColumns Send AddValueItem "Language ID" (WindowsLocale(LOCALE_ILANGUAGE, 5)) 54 Send AddValueItem "Language name" (WindowsLocale(LOCALE_SLANGUAGE, 100)) 54 Send AddValueItem "Language english name" (WindowsLocale(LOCALE_SENGLANGUAGE, 100)) 54 Send AddValueItem "Language abbreviated name" (WindowsLocale(LOCALE_SABBREVLANGNAME, 3)) 54 Send AddValueItem "Language native name" (ToOem(WindowsLocale(LOCALE_SNATIVELANGNAME, 100))) 54 End_Procedure Procedure SI_Numbers Send AddValueColumns Send AddValueItem "Decimal symbol" (WindowsLocale(LOCALE_SDECIMAL, 5)*'('+String(Ascii(WindowsLocale(LOCALE_SDECIMAL, 5)))+')') 54 Send AddValueItem "Thousands separator" (WindowsLocale(LOCALE_STHOUSAND, 5)*'('+String(Ascii(WindowsLocale(LOCALE_STHOUSAND, 5)))+')') 54 Send AddValueItem "Digits grouping" (WindowsLocale(LOCALE_SGROUPING, 10)) 54 Send AddValueItem "Number of digits after decimal" (WindowsLocale(LOCALE_IDIGITS, 3)) 54 Send AddValueItem "Leading zeroes" (WindowsLocale(LOCALE_ILZERO, 2)) 54 Send AddValueItem "Negative number mode" (WindowsLocale(LOCALE_INEGNUMBER, 2)) 54 Send AddValueItem "Negative digits" (WindowsLocale(LOCALE_SNATIVEDIGITS, 2)) 54 End_Procedure Procedure SI_Currency Send AddValueColumns Send AddValueItem "Currency symbol" (ToOem(WindowsLocale(LOCALE_SCURRENCY, 6))) 54 Send AddValueItem "International symbol" (WindowsLocale(LOCALE_SINTLSYMBOL, 4)) 54 Send AddValueItem "Decimal symbol" (WindowsLocale(LOCALE_SMONDECIMALSEP, 4)) 54 Send AddValueItem "Thousands separator" (WindowsLocale(LOCALE_SMONTHOUSANDSEP, 4)) 54 Send AddValueItem "Digits grouping" (WindowsLocale(LOCALE_SMONGROUPING, 4)) 54 Send AddValueItem "Local currency digits" (WindowsLocale(LOCALE_ICURRDIGITS, 3)) 54 Send AddValueItem "International currency digits" (WindowsLocale(LOCALE_IINTLCURRDIGITS, 3)) 54 Send AddValueItem "Positive mode" (WindowsLocale(LOCALE_ICURRENCY, 2)) 54 Send AddValueItem "Negative mode" (WindowsLocale(LOCALE_INEGCURR, 3)) 54 Send AddValueItem "Positive currency sign" (WindowsLocale(LOCALE_SPOSITIVESIGN, 2)*'('+String(Ascii(WindowsLocale(LOCALE_SPOSITIVESIGN, 2)))+')') 54 Send AddValueItem "Negative currency sign" (WindowsLocale(LOCALE_SNEGATIVESIGN, 2)*'('+String(Ascii(WindowsLocale(LOCALE_SNEGATIVESIGN, 2)))+')') 54 Send AddValueItem "Formatting index for positive values" (WindowsLocale(LOCALE_IPOSSIGNPOSN, 2)) 54 Send AddValueItem "Formatting index for negative values" (WindowsLocale(LOCALE_INEGSIGNPOSN, 2)) 54 Send AddValueItem "Symbol position in a positive value" (WindowsLocale(LOCALE_IPOSSYMPRECEDES, 2)) 54 Send AddValueItem "Symbol separation in a positive value" (WindowsLocale(LOCALE_IPOSSEPBYSPACE, 2)) 54 Send AddValueItem "Symbol position in a negative value" (WindowsLocale(LOCALE_INEGSYMPRECEDES, 2)) 54 Send AddValueItem "Symbol separation in a negative value" (WindowsLocale(LOCALE_INEGSEPBYSPACE, 2)) 54 End_Procedure Procedure SI_Country Send AddValueColumns Send AddValueItem "Country ID" (WindowsLocale(LOCALE_ICOUNTRY, 6)) 54 Send AddValueItem "Country Name" (WindowsLocale(LOCALE_SCOUNTRY, 100)) 54 Send AddValueItem "Country english name" (WindowsLocale(LOCALE_SENGCOUNTRY, 100)) 54 Send AddValueItem "Country abbreviated name" (WindowsLocale(LOCALE_SABBREVCTRYNAME, 100)) 54 Send AddValueItem "Country native name" (ToOem(WindowsLocale(LOCALE_SNATIVECTRYNAME, 100))) 54 End_Procedure Procedure SI_Regional Send AddValueColumns Send AddValueItem "Country ID" (WindowsLocale(LOCALE_IDEFAULTCOUNTRY, 6)) 54 Send AddValueItem "Language ID" (WindowsLocale(LOCALE_IDEFAULTLANGUAGE, 5)) 54 Send AddValueItem "Language name" (GetLanguageName(WindowsLocale(LOCALE_IDEFAULTLANGUAGE, 5))) 54 Send AddValueItem "ANSI code page ID" (WindowsLocale(LOCALE_IDEFAULTANSICODEPAGE, 6)) 54 Send AddValueItem "Code page" (WindowsLocale(LOCALE_IDEFAULTCODEPAGE, 6)) 54 Send AddValueItem "List separator" (WindowsLocale(LOCALE_SLIST, 4)) 54 Send AddValueItem "Measure ID" (WindowsLocale(LOCALE_IMEASURE, 2)) 54 Send AddValueItem "Paper size" (WindowsLocale(LOCALE_IPAPERSIZE, 10)) 54 End_Procedure Procedure SI_Keyboard Send AddValueColumns Send AddValueItem "Keyboard type" (GetKeyboardType()) 8 Send AddValueItem "Keyboard subtype" (GetKeyboardSubType()) 8 Send AddValueItem "Function keys" (GetKeyboardFuncKeys()) 8 Send AddValueItem "Layout ID" (GetKeyboardLayoutID()) 8 Send AddValueItem "Layout name" (GetKeyboardLayoutName()) 8 End_Procedure #IF (!@<80) Procedure SI_Workspace Send AddValueColumns If (ghoWorkspace=0) Begin Send AddValueItem "Workspace" "Not used" 58 Procedure_Return End Send AddValueItem "Name" (CurrentWorkspaceName(ghoWorkspace)) 58 Send AddValueItem "Description" (CurrentWorkspaceDescription(ghoWorkspace)) 58 Send AddValueItem "File paths" (CurrentDfPath(ghoWorkspace)) 58 // Send AddValueItem "HTM" (CurrentApppHTMPath(ghoWorkspace)) 58 Send AddValueItem "Bitmaps" (CurrentBitMapPath(ghoWorkspace)) 58 Send AddValueItem "Data" (CurrentDatapath(ghoWorkspace)) 58 Send AddValueItem "Help" (CurrentHelppath(ghoWorkspace)) 58 Send AddValueItem "Program" (CurrentProgramPath(ghoWorkspace)) 58 Send AddValueItem "File list" (CurrentFileListPath(ghoWorkspace)) 58 End_Procedure #ELSE Procedure SI_Workspace Integer hoWS Send AddValueColumns If (ghoApplication <> 0) Get phoWorkSpace Of ghoApplication To hoWS If (hoWS=0) Begin Send AddValueItem "Workspace" "Not used" 58 Procedure_Return End Send AddValueItem "Workspace" (psWorkspaceName(hoWS)) 58 Send AddValueItem "Description" (psDescription(hoWS)) 58 Send AddValueItem "File paths" (psHome(hoWS)) 58 Send AddValueItem "HTM" (psAppHTMLPath(hoWS)) 58 Send AddValueItem "Bitmaps" (psBitmapPath(hoWS)) 58 Send AddValueItem "Data" (psDataPath(hoWS)) 58 Send AddValueItem "Help" (psHelpPath(hoWS)) 58 Send AddValueItem "Program" (psProgramPath(hoWS)) 58 Send AddValueItem "File list" (psFilelist(hoWS)) 58 End_Procedure #ENDIF Procedure SI_DataFiles Integer iRow Handle hFile String sLName sRName sDName Send AddFilesColumns Move 0 To hFile Repeat Get_Attribute DF_FILE_NEXT_USED Of hFile To hFile If (hFile>0) Begin Get_Attribute DF_FILE_LOGICAL_NAME Of hFile To sLName Get_Attribute DF_FILE_DISPLAY_NAME Of hFile To sDName Get_Attribute DF_FILE_ROOT_NAME Of hFile To sRName Send AddFilesItem (String(hFile)) sLName sDName sRName End Until (hFile=0) End_Procedure Procedure SI_DataFile Integer hFile Integer iOpen iClose Integer iVal iAtt String sName Send AddValueColumns 0 "Attribute" // Get_Attribute DF_FILE_OPENED Of hFile To iOpen If (Not(iOpen)) Begin Open hFile Move 1 To iClose End // Send AddValueItem "File number" hFile 58 Get_Attribute DF_FILE_LOGICAL_NAME Of hFile To sName Send AddValueItem "Logical name" sName 58 Get_Attribute DF_FILE_REVISION Of hFile To sName Send AddValueItem "File revision" sName 58 Get_Attribute DF_FILE_DRIVER Of hFile To sName Send AddValueItem "Driver" sName 58 // Get_Attribute DF_FILE_DISPLAY_NAME Of hFile To sName Send AddValueItem "Display name" sName 58 Get_Attribute DF_FILE_ROOT_NAME Of hFile To sName Send AddValueItem "Root name" sName 58 Get_Attribute DF_FILE_PHYSICAL_NAME Of hFile To sName Send AddValueItem "Physical name" sName 58 Get_Attribute DF_FILE_ALIAS Of hFile To iVal If (iVal=DF_FILE_ALIAS_DEFAULT) Move "Default" To sName Else If (iVal=DF_FILE_IS_MASTER) Move "Master" To sName Else If (iVal=DF_FILE_IS_ALIAS) Move "Alias" To sName Send AddValueItem "Alias state" sName 58 Get_Attribute DF_FILE_IS_SYSTEM_FILE Of hFile To iVal If (iVal) Move "Yes" To sName Else Move "No" To sName Send AddValueItem "System file" sName 58 Get_Attribute DF_FILE_OWNER Of hFile To sName If (sName="") Move "N/A" To sName Send AddValueItem "Owner" sName 58 Get_Attribute DF_REPORT_UNSUPPORTED_ATTRIBUTES To iAtt Set_Attribute DF_REPORT_UNSUPPORTED_ATTRIBUTES To False Get_Attribute DF_FILE_LOGIN Of hFile To sName Set_Attribute DF_REPORT_UNSUPPORTED_ATTRIBUTES To iAtt If (sName="") Move "N/A" To sName Send AddValueItem "Login" sName 58 Get_Attribute DF_FILE_MAX_RECORDS Of hFile To iVal Send AddValueItem "Records allowed" iVal 58 Get_Attribute DF_FILE_RECORDS_USED Of hFile To iVal Send AddValueItem "Records used" iVal 58 Get_Attribute DF_FILE_RECORD_LENGTH Of hFile To iVal Send AddValueItem "Record length" iVal 58 Get_Attribute DF_FILE_RECORD_LENGTH_USED Of hFile To iVal Send AddValueItem "Record length used" iVal 58 Get_Attribute DF_FILE_COMPRESSION Of hFile To iVal If (iVal=DF_FILE_COMPRESS_NONE) Move "None" To sName Else If (iVal=DF_FILE_COMPRESS_STANDARD) Move "Standard" To sName Else If (iVal=DF_FILE_COMPRESS_FAST) Move "Fast" To sName Else If (iVal=DF_FILE_COMPRESS_CUSTOM) Move "Custom" To sName Send AddValueItem "File compression" sName 58 Get_Attribute DF_FILE_LOCK_TYPE Of hFile To iVal If (iVal=DF_LOCK_TYPE_NONE) Move "None" To sName Else If (iVal=DF_LOCK_TYPE_FILE) Move "File" To sName Else If (iVal=DF_LOCK_TYPE_RECORD) Move "Record" To sName Send AddValueItem "Lock type" sName 58 Get_Attribute DF_FILE_TRANSACTION Of hFile To iVal If (iVal=DF_FILE_TRANSACTION_NONE) Move "None" To sName Else If (iVal=DF_FILE_TRANSACTION_CLIENT_ATOMIC) Move "Client atomic" To sName Else If (iVal=DF_FILE_TRANSACTION_SERVER_ATOMIC) Move "Server atomic" To sName Else If (iVal=DF_FILE_TRANSACTION_SERVER_LOGGED) Move "Server logged" To sName Send AddValueItem "Transaction processing" sName 58 Get_Attribute DF_FILE_NUMBER_FIELDS Of hFile To iVal Send AddValueItem "Number fields" iVal 58 Get_Attribute DF_FILE_LAST_INDEX_NUMBER Of hFile To iVal Send AddValueItem "Last index" iVal 58 // If (iClose) Close hFile End_Procedure Procedure SI_Drivers Integer iNumDriversLoaded iDrvNum iRow String sDriverName Send AddDriversColumns Get_Attribute DF_NUMBER_DRIVERS To iNumDriversLoaded For iDrvNum From 1 To iNumDriversLoaded Get_Attribute DF_DRIVER_NAME Of iDrvNum To sDriverName Send AddDriverItem sDriverName Loop End_Procedure Procedure SI_Database Integer iVal String sName Send AddValueColumns 0 "Attribute" Get_Attribute DF_FILELIST_NAME To sName Send AddValueItem "Filelist name" sName 58 Get_Attribute DF_HIGH_DATA_INTEGRITY To iVal Send AddValueItem "High data integrity" (If(iVal, "Yes", "No")) 58 Get_Attribute DF_LOCK_DELAY To iVal Send AddValueItem "Lock delay" (String(iVal)*"ms") 58 Get_Attribute DF_LOCK_TIMEOUT To iVal Send AddValueItem "Lock timeout" (String(iVal)*"ms") 58 Get_Attribute DF_NUMBER_DRIVERS To iVal Send AddValueItem "Database drivers" (String(iVal)) 58 End_Procedure Function Field_Name Integer hFile Integer iField Returns String Integer iOpen iClose String sName Get_Attribute DF_FILE_OPENED Of hFile To iOpen If (Not(iOpen)) Begin Open hFile Move 1 To iClose End Get_Attribute DF_FIELD_NAME Of hFile iField To sName If (iClose) Close hFile Function_Return sName End_Function Procedure SI_DataFields Integer hFile Integer iRow iVal iField iFields iIdx String sName sField sType sLen sIndex sRel Integer iOpen iClose iLength iDigits iRelFile iRelField Get_Attribute DF_FILE_OPENED Of hFile To iOpen If (Not(iOpen)) Begin Open hFile Move 1 To iClose End // Send AddFieldsColumns // Send DoInsertColumn "Name" 0 125 LVCFMT_LEFT // Send DoInsertColumn "Type" 1 40 LVCFMT_LEFT // Send DoInsertColumn "Length" 2 50 LVCFMT_RIGHT // Send DoInsertColumn "Idx" 3 30 LVCFMT_RIGHT // Send DoInsertColumn "Relation" 4 135 LVCFMT_LEFT // Get_Attribute DF_FILE_NUMBER_FIELDS Of hFile To iFields For iField From 1 To iFields Move "" To sName Move "" To sType Move "" To sIndex Move "" To sLen Move "" To sRel Get_Attribute DF_FIELD_NAME Of hFile iField To sName Get_Attribute DF_FIELD_TYPE Of hFile iField To iVal If (iVal=DF_ASCII) Move "ASC" To sType Else If (iVal=DF_BCD) Move "NUM" To sType Else If (iVal=DF_DATE) Move "DAT" To sType Else If (iVal=DF_OVERLAP) Move "OVE" To sType Else If (iVal=DF_TEXT) Move "TXT" To sType Else If (iVal=DF_BINARY) Move "BIN" To sType Get_Attribute DF_FIELD_LENGTH Of hFile iField To iLength Get_Attribute DF_FIELD_PRECISION Of hFile iField To iDigits If (iDigits) Move (String(iLength)+','+String(iDigits)) To sLen Else Move (String(iLength)) To sLen Get_Attribute DF_FIELD_INDEX Of hFile iField To iIdx If (iIdx) Move (String(iIdx)) To sIndex Get_Attribute DF_FIELD_RELATED_FILE Of hFile iField To iRelFile If (iRelFile) Begin Get_Attribute DF_FIELD_RELATED_FIELD Of hFile iField To iRelField Get_Attribute DF_FILE_LOGICAL_NAME Of iRelFile To sRel Get Field_Name hFile iField To sField Move (sRel+'.'+sField) To sRel End Send AddFieldsItem sName sType sLen sIndex sRel Loop // If (iClose) Close hFile End_Procedure Procedure SI_Indexes Integer hFile Integer iOpen iClose iCnt iIndx iSegments iVal String sName sSeg sType sLev sKey sBuf // Send AddIndexColumns // Get_Attribute DF_FILE_OPENED Of hFile To iOpen If (Not(iOpen)) Begin Open hFile Move 1 To iClose End Get_Attribute DF_FILE_LAST_INDEX_NUMBER Of hFile To iCnt For iIndx From 1 To iCnt Get_Attribute DF_INDEX_NUMBER_SEGMENTS Of hFile iIndx To iSegments If (iSegments) Begin Move "" To sName Move "" To sSeg Move "" To sType Move "" To sLev Move "" To sKey Move "" To sBuf Move ("Index."+String(iIndx)) To sName Move (String(iSegments)) To sSeg Get_Attribute DF_INDEX_TYPE Of hFile iIndx To iVal If (iVal=DF_INDEX_TYPE_ONLINE) Move "Online" To sType Else If (iVal=DF_INDEX_TYPE_BATCH) Move "Batch" To sType Else Move "* Unknown *" To sType Get_Attribute DF_INDEX_LEVELS Of hFile iIndx To sLev Get_Attribute DF_INDEX_KEY_LENGTH Of hFile iIndx To sKey Get_Attribute DF_INDEX_NUMBER_BUFFERS Of hFile iIndx To sBuf Send AddIndexItem sName sSeg sType sLev sKey sBuf End Loop If (iClose) Close hFile End_Procedure Procedure SI_IndexData Integer hFile Integer iIndex Integer iOpen iClose iSegments iVal iSeg iField String sName sCase sDir Send AddIdxDataColumns Get_Attribute DF_FILE_OPENED Of hFile To iOpen If (Not(iOpen)) Begin Open hFile Move 1 To iClose End Get_Attribute DF_INDEX_NUMBER_SEGMENTS Of hFile iIndex To iSegments For iSeg From 1 To iSegments Move "" To sName Move "" To sCase Move "" To sDir Get_Attribute DF_INDEX_SEGMENT_FIELD Of hFile iIndex iSeg To iField Get_Attribute DF_FIELD_NAME Of hFile iField To sName Get_Attribute DF_INDEX_SEGMENT_CASE Of hFile iIndex iSeg To iVal If (iVal=DF_CASE_USED) Move "" To sCase Else Move "Yes" To sCase Get_Attribute DF_INDEX_SEGMENT_DIRECTION Of hFile iIndex iSeg To iVal If (iVal=DF_ASCENDING) Move "" To sDir Else Move "Yes" To sDir Send AddIdxDataItem sName sCase sDir Loop If (iClose) Close hFile End_Procedure Procedure SI_Attributes Integer iVal String sName Send AddValueColumns 50 "Attribute" // Get_Attribute DF_THOUSANDS_SEPARATOR To iVal Send AddValueItem "Thousands Separator" ('"'*Character(iVal)*'" ('+String(iVal)+')') 58 // Get_Attribute DF_DECIMAL_SEPARATOR To iVal Send AddValueItem "Decimal separator" ('"'*Character(iVal)*'" ('+String(iVal)+')') 58 // Get_Argument_Size To iVal Send AddValueItem "Argument size" (String(iVal)) 58 // Get_Attribute DF_STRICT_ATTRIBUTES To iVal Send AddValueItem "Strict attributes" (If(iVal, "Yes", "No")) 58 // Get_Attribute DF_REPORT_UNSUPPORTED_ATTRIBUTES To iVal Send AddValueItem "Report unsupported attributes" (If(iVal, "Yes", "No")) 58 // Get_Attribute DF_RUNTIME_PROGRESS_FREQUENCY To iVal Send AddValueItem "Runtime progress frequency interval" (String(iVal)*"ms") 58 // Get_Attribute DF_OPEN_PATH To sName Send AddValueItem "Open path (Dfpath)" sName 58 // Get_Date_Attribute SYSDATE4_STATE To iVal Send AddValueItem "Sysdate4_State" (If(iVal, "Yes", "No")) 58 // Get_Date_Attribute DATE4_STATE To iVal Send AddValueItem "Date4_State" (If(iVal, "Yes", "No")) 58 // Get_Date_Attribute EPOCH_VALUE To iVal Send AddValueItem "Epoch" (String(iVal)) 58 // Get_Attribute DF_DATE_SEPARATOR To iVal Send AddValueItem "Date separator" ('"'*Character(iVal)*'" ('+String(iVal)+')') 58 // Get_Attribute DF_DATE_FORMAT To iVal If (iVal=DF_DATE_USA) Move "USA" To sName Else If (iVal=DF_DATE_EUROPEAN) Move "European" To sName Else If (iVal=DF_DATE_MILITARY) Move "Military" To sName Send AddValueItem "Date Format" sName 58 End_Procedure Procedure SI_Variables Send AddValueColumns 50 "Attribute" Send AddValueItem "PageEnd" (String(PageEnd)) 58 Send AddValueItem "PageFeed" (String(PageFeed)) 58 Send AddValueItem "PageCount" (String(PageCount)) 58 Send AddValueItem "LineCount" (String(LineCount)) 58 Send AddValueItem "FLX_Revision" (String(FLX_Revision)) 58 Send AddValueItem "Constrain_Tests_Count" (String(Constrain_Tests_Count)) 58 Send AddValueItem "Constrain_Found_Count" (String(Constrain_Found_Count)) 58 Send AddValueItem "LastErr" (String(lasterr)) 58 Send AddValueItem "Chain_Depth" (String(Chain_Depth)) 58 Send AddValueItem "Total_Resources" (String(Total_Resources)) 58 Send AddValueItem "Total_Objects" (String(Total_Objects)) 58 End_Procedure Procedure SI_AppData Integer iCnt iItem hFile iName iValue iOpen iClose Integer iField iFields String sName sValue sFile // Send AddValueColumns 50 // Get Item_Count Of (oAppFiles(Self)) To iCnt For iItem From 0 To (iCnt-1) Move "" To sName Move "" To sValue Get piAppFile iItem To hFile If (hFile) Begin Get_Attribute DF_FILE_OPENED Of hFile To iOpen Get_Attribute DF_FILE_LOGICAL_NAME Of hFile To sFile If (Not(iOpen)) Begin Open hFile Move 1 To iClose End Get piAppName iItem To iName If (iName=0) Begin Clear hFile Vfind hFile 0 Ge Get_Attribute DF_FILE_NUMBER_FIELDS Of hFile To iFields For iField From 1 To iFields Get_Attribute DF_FIELD_NAME Of hFile iField To sName Get_Field_Value hFile iField To sValue Send AddValueItem (sFile+'\'+sName) sValue 59 Loop End Else Begin Get piAppName iItem To iName Get piAppValue iItem To iValue If (iValue<>0) Begin Clear hFile Indicate found True While (found) Vfind hFile 0 Gt If (found) Begin Get_Field_Value hFile iName To sName Get_Field_Value hFile iValue To sValue Send AddValueItem (sFile+'\'+sName) sValue 59 End Loop End End If (iClose) Close hFile If (iItem<>(iCnt-1)) Send AddEmptyItem End Loop // End_Procedure Function SI_VDFRootDir Returns String String sVdfRootDir Get_Profile_String "Defaults" "VdfRootDir" To sVdfRootDir Move (Trim (sVdfRootDir)) To sVdfRootDir If (Right (sVdfRootDir, 1) <> SysConf (Sysconf_Dir_Separator)) Begin Move (sVdfRootDir - SysConf (Sysconf_Dir_Separator)) To sVdfRootDir End Function_Return sVdfRootDir End_Function Procedure SI_Runtime Integer iOk hoVersion String sName sRoot // Send AddEFileColumns // Get Create U_cWinVerEx To hoVersion Get SI_VDFRootDir To sRoot If (sRoot<>"") Move (sRoot+"Bin\") To sRoot Direct_Input Channel 9 ("DIR:"+sRoot+"*.*") While (Not (seqeof)) Readln Channel 9 sName If (Not (seqeof) And Left (sName, 1) <> "[") Begin If ((Uppercase(sName) Contains ".DLL")Or(Uppercase(sName) Contains ".EXE")Or(Uppercase(sName) Contains ".DRV")Or(Uppercase(sName) Contains ".OCX")) Begin Get Read_File Of hoVersion (sRoot+sName) To iOk If (iOk) Begin Send AddEFileItem sName (LastWrite_DateTime(hoVersion)) ; (FileSize_Bytes(hoVersion)) (String(Major_Version(hoVersion))+'.'+String(Minor_Version(hoVersion))+'.'+String(Release_Version(hoVersion))+'.'+String(Build_Version(hoVersion)) ) End End End End Close_Input Channel 9 Send Destroy Of hoVersion End_Procedure Function mFileFromPath String sFile Returns String Integer iPos Move (Length(sFile) ) To iPos While (iPos >0) If (Mid(sFile, 1, iPos)) In "\:" Function_Return (Right(sFile, Length(sFile) -iPos)) Decrement iPos Loop End_Function Procedure SI_Modules Integer hoProcessModulesArray iModules iModule hoVersion Boolean iOk String sModule sFile // Send AddEFileColumns Get Create U_cProcessModulesArray To hoProcessModulesArray If (hoProcessModulesArray <> 0) Begin Send DoEnumProcessModules Of hoProcessModulesArray Move (Item_Count (hoProcessModulesArray) - 1) To iModules If (iModules >= 0) Begin Get Create U_cWinVerEx To hoVersion Move (Item_Count (hoProcessModulesArray) - 1) To iModules For iModule From 0 To iModules Get String_Value Of hoProcessModulesArray Item iModule To sFile If (sFile <> "") Begin Get mFileFromPath sFile To sModule Get Read_File Of hoVersion sFile To iOk Send AddEFileItem sModule (LastWrite_DateTime(hoVersion)) (FileSize_Bytes(hoVersion)) ; ( String(Major_Version(hoVersion))+'.'+String(Minor_Version(hoVersion))+'.'+String(Release_Version(hoVersion))+'.'+String(Build_Version(hoVersion)) ) End Loop Send Destroy Of hoVersion End Send Destroy Of hoProcessModulesArray End End_Procedure Procedure OnRequestSplitter // Procedure_Return 1 End_Procedure Procedure OnSplitterChange Integer iTrack Set GUILocation To (Hi(GUILocation(Self))) (Low(GUILocation(Self))+iTrack) Set GuiSize To (Hi(GuiSize(Self))) (Low(GuiSize(Self))-iTrack) End_Procedure //AB-StoreEnd End_Object // oWinListView1 Object oSaveAsDialog1 is a SaveAsDialog //AB/ Set Location to 222 5 Set Dialog_Caption to "Save System Info" Set Filter_String to "Plain HTML|*.htm|Rich Text Format|*.rtf|Text|*.txt|All Files|*.*" //AB-StoreStart Procedure DoCallSaveAsDialog Integer iVoid String sFileTitle sType String sFileName Set File_Title To "" Set psFile To "" Get Show_Dialog Of oSaveAsDialog1 To iVoid If iVoid Begin Get File_Name Of (oSaveAsDialog1 (Self)) To sFileName Set psFile To sFileName Move (Uppercase(Replace(".", SWAPathFindExtension(sFileName), ""))) To sType If (sType="") Begin Move "HTM" To sType Move (sFileName+".htm") To sFileName End If ("HTM|TXT|RTF" Contains sType) Begin Set psOutput To sType Set psFile To sFileName End Else Begin Set psOutput To "LIST" Set psFile To "" Send Stop_Box "Invalid output file format selected" "System Info Error" Procedure_Return End Send DoSaveSysInfo End End_Procedure // DoCallSaveAsDialog //AB-StoreEnd End_Object // oSaveAsDialog1 //AB-StoreStart Object oVerticalSplitter1 Is A cVerticalSplitter Set peAnchors To anTopBottom Set GuiLocation To (Hi(GuiLocation(oTreeView1(Self)))) (Low(GuiLocation(oTreeView1(Self)))+Low(GuiSize(oTreeView1(Self)))+1) Set GuiSize To (Hi(GuiSize(oTreeView1(Self)))) 3 Send DoAddObjectToNotify (oTreeView1(Self)) Send DoAddObjectToNotify (oWinListView1(Self)) End_Object Procedure DoSaveSysInfo String sOut sFile sTmp sUser sComp sCss sCssFile DateTime dtNow Integer iOk // Move (CurrentDateTime()) To dtNow Get psOutput To sOut If (sOut<>"LIST") Begin If (ghoStatusPanel) Begin Send Initialize_StatusPanel Of ghoStatusPanel "Collecting System Information..." "" "" Send Start_StatusPanel Of ghoStatusPanel End Get psFile To sFile If (sFile<>"") Begin Move (GetUserName()) To sUser Move (GetComputerName()) To sComp If (sOut="TXT") Begin Direct_Output sFile Writeln "<< SYSTEM INFO FILE >>" Writeln Writeln "User name: " sUser Writeln "Computer name: " sComp Writeln "Generated on: " dtNow Writeln "Generated file: " sFile Writeln "SysInfo Revision: " (psSysInfoRevision(Self)) Writeln End Else If (sOut="HTM") Begin // Set output mode to HTML Set pbOutput Of (oOutput(Self)) To False Move (SWAPathRenameExtension(sFile, ".css")) To sCss If (sCss<>"") Begin Direct_Output sCss Output CSS_TABLE_IMAGE Close_Output Set psStyleSheet Of (oOutput(Self)) To (SWAPathStripPath(sCss)) Set psCharSet Of (oOutput(Self)) To ("windows-"+String(WindowsLocale(LOCALE_IDEFAULTANSICODEPAGE, 6))) End Send mOutputHeader To (oOutput(Self)) sFile "System Info" Send mOutputTag To (oOutput(Self)) "TITLE" "HEADER 1" "System Information" "" Send mOutputTag To (oOutput(Self)) "HTMLTAG" "" ("

User name:"*sUser+"
") "" Send mOutputTag To (oOutput(Self)) "HTMLTAG" "" ("Computer name:"*sComp+"
") "" Send mOutputTag To (oOutput(Self)) "HTMLTAG" "" ("Generated on:"*String(dtNow)+"
") "" Send mOutputTag To (oOutput(Self)) "HTMLTAG" "" ("Generated file:"*sFile+"
") "" Send mOutputTag To (oOutput(Self)) "HTMLTAG" "" ("SysInfo Revision:"*psSysInfoRevision(Self)+"
") "" Send mOutputTag To (oOutput(Self)) "TEXT" "TIP" "Legal Information" "This file may include confidential information. If you got this file by mistake, please immediately remove it from your system!" Send mOutputTag To (oOutput(Self)) "HTMLTAG" "" "

" "" End Else If (sOut="RTF") Begin // Set output mode to RTF Set pbOutput Of (oOutput(Self)) To True Move sFile To sTmp Move (Replaces("\", sTmp, "?")) To sTmp Move (Replaces("?", sTmp, "\\")) To sTmp Send mOutputHeader To (oOutput(Self)) sFile "" Send mOutputTag To (oOutput(Self)) "TITLE" "HEADER 1" "System Information" "" Send mOutputTag To (oOutput(Self)) "TEXT" "PARAGRAPH" "" ("User name:"*sUser) Send mOutputTag To (oOutput(Self)) "TEXT" "PARAGRAPH" "" ("Computer name:"*sComp) Send mOutputTag To (oOutput(Self)) "TEXT" "PARAGRAPH" "" ("Generated on:"*String(dtNow)) Send mOutputTag To (oOutput(Self)) "TEXT" "PARAGRAPH" "" ("Generated file:"*sTmp) Send mOutputTag To (oOutput(Self)) "TEXT" "PARAGRAPH" "" ("SysInfo Revision:"*psSysInfoRevision(Self)) Send mOutputTag To (oOutput(Self)) "TEXT" "NOTE" "Legal Information" "This file may include confidential information. If you got this file by mistake, please immediately remove it from your system!" Send mOutputTag To (oOutput(Self)) "RTFTAG" "" "" "{\page }" End // Send DoCreateTree To (oTreeView1(Self)) // If (sOut="TXT") Begin Writeln Writeln "<< END OF SYSTEM INFO FILE >>" Close_Output End Else Begin Send mOutputFooter To (oOutput(Self)) End // Get YesNo_Box ("Program System Information saved to \n\n"*psFile(Self)+"\n\nDo you wish to open generated file?") "System Info" MBR_YES To iOk If (iOk=MBR_YES) Send ShellExecute "open" sFile 1 // Set psOutput To "LIST" Set psFile To "" // If (ghoStatusPanel) Send Stop_StatusPanel Of ghoStatusPanel End End End_Procedure //AB-StoreEnd End_Object // oSysInfo //AB-StoreStart //AB-StoreEnd //AB/ End_Object // oIDE_Project
DescriptionFull pathShort path
"+sKey+"Value
Printer namePortShare
DriveLabelTypeDescription
No.LogicalDisplayRoot
Loaded drivers
NameTypeLengthIdxRelation
NameSegmentsTypeLevelsKey LengthBuffers
FileDateSizeVersion
SegmentCaseDirection
"+sDesc+""+sPath+""+sShort+"
"+sName+""+(ToAnsi(sValue))+"
"+sName+""+sPort+""+sShare+"
"+sDrive+""+sLabel+""+sType+""+sDesc+"
"+sFile+""+sLName+""+sDName+""+sRName+"
"+sDriver+"
"+sName+""+sType+""+iLength+""+iIdx+""+sRel+"
"+sName+""+sSeg+""+sType+""+sLev+""+sKey+""+sBuf+"
"+sFile+""+sDate+""+sSize+""+sVer+"
"+sSeg+""+sCase+""+sDir+"