* NetINSt Custom Network Installer Class * Authors: A.A. Katz, KSoft, Inc. and Jim Sare, Aljaka Enterprises * Both authors are members of TeamB * This custom class was designed, executed and tested by AAK. * Jim Sare created the wonderful WIN API methods that extract * the filenames from a running .EXE * * All Rights Reserved You may include this Class in your applications, compile it and * distribute it at no cost. You may not, however, sell this code * or include it in any collection of tools sold for resale. * You must credit the authors of this code whenever used. * V.2.0 11-16-1995 * V.3.0 8-3-1996 * NetInst , the network installer class is incorporated right into the startup of your * deployed application. * * It performs two main functions: * 1. It copies your empty shared tables out to the common network server * drive and/or * 2. It sets _app.path, a global property containing the full path to * the shared server files (including a trailing backslash: F:\NetDir\) * * NetInst is totally automatic. * 1. It looks for a file called Path.Mem in the working directory each * time your application starts * 2. If it exists, it stores your network path to the _app.path property and * your program continues executing. No feedback is given. This is a * "normal" startup * 3. If Path.mem is not found, a dialog pops up asking for the drive and * path to the server directory. User enters, clicks OK * 4. If the directory does not exist, NetInst will ask for permission and * then create it. * 5. If it does exist, it will look for a Server Test file that you specify * (a file that should be there if your tables have already been * copied to the server) to determine whether a full Server installation * is required or if only a Workstation installation is required. * 6. If a full Server installation is required, NetInst pops up a dialog * asking permission to copy the tables packaged in your .EXE out * to the specified directory. When done, it stores the path in a local * path.mem, sets up _app.path and continues on running your program. * 7. If a Workstation installation is required, NetInst stores the path to * the local Path.mem, sets up _app.path and continues on running * your program. *In summary: Netinst transparently checks path.mem. If Path OK, program opens * or Netinst will automatically set up your server * or NetInst will automatically set up the workstation to find the server * files. * * Recovery: If either a Workstation or Server install fails, or the user Cancels at * any point, NetInst issues a QUIT so that your program cannot continue * loading. * It is always assumed that a Path to the Server is required or your * program cannot run. * WARNING - you must design your application to use _app.path to open your * tables. You have two options: * * 1. Set Path To (_app.Path) * 2. Use (_app.path+'Customer') in your QBE's when opening tables * * If you are explicitly saving ANY shared files, (including mem files), I * recommend that you use explicit pathing: * Save All Like Net* to (_app.Path+'NetSetup') * * To reset path or force tables into a new directory, just remove * Path.mem from the current workstation working directory, and * NetInst will pop up next time you run your program. * * NetInst should be instantiated in some kind of Startup.Prg. You * can call it before or after the VdB shell or your own background * form is opened, or you can call it first thing and it will pop up * right over the Windows desktop. Just be sure no tables are opened * until after NetInst executes. * * Calling code: * Startup.prg: * * SET TALK OFF && Set environment * SET CUAENTER OFF * * Open a background form (or not, your choice) * * Set Proc to \Visualdb\Custom\Net.cc addi && Load Procedure * Local f * f = New NetInst('MYPROG.EXE,'MYFILE.DBF') && Instantiate NetInst * f.VerifyPath() && Call main method * && If still no valid * && server path, NetInst * && issues QUIT. * f = '' && Stub out object * Close Proc \Visualdb\custom\Net.cc && Close procedure. * * Set Path to (_app.path) && do what you want with _app.path. * * Where MyProg.exe is the currently running .EXE and * MYFILE.DBF is any table you would expect to find on * the server if your program has already been set up * Example: 'CUSTOMER.DBF' * * Good luck with NetInst. If you've got some great enhancements, let me * know.... AAK ********************************************************** *----------------Class for installing app on networks CLASS NETINST(cThisExe,cTestServer) && cThisExe is the name of the .EXE file in which your tables && are stored. Shared server-based tables must be linked into && your .EXE for NetInst to be able to copy them to the server && cTestserver is the full name of a .DBF file && (ex: Customer.dbf) that you would expect to find in the && server directory if your program was already installed This.DirIsOk = .f. &&Property: drive and directory ok? This.Path = '' This.cExe = cThisExe This.TestServerFile = iif(empty(cTestServer),'',cTestServer) *-------------------------------------------------------------------- * This method attemps to restore your path from * Path.Mem. If that fails, or the path restored is * invalid, the Network Installer Open()s itself * and allows the user to set up the Server and * the path the workstation needs to find the * Server files. *------------------------------------------------------------------- Procedure VerifyPath Private cOldPath && Var to store current path. Private cPath && Temp var for testing path This.StartPathIsOk = .f. && Property to test for path ok. _app.Path = ' ' && Custom property of the application && object to use to store Server path. If File('Path.mem') && If path file exists,. Rest From Path.Mem Additive && restore path var Endif If Type('m_Path') = 'C' .and. .not. empty(m_path) && If path var exists This.StartPathIsOk = .t. cOldPath = SET("DIRECTORY") && Store current directory cPath = substr(m_path,1,Len(m_path)-1) &&strip off trailing && backslash On Error This.StartPathErr() && Set error in case of failure CD &cPath && Try to change directory On Error && Reset error && If the CD command causes an error, This.StartPathIsOK && gets set to False by StartPathErr() cd &cOldPath && Change back to original Path If This.StartPathIsOk This.path = m_path Endif Else This.StartPathIsOk = .f. && Path was never set up Endif If .not. This.StartPathIsOk && If no valid path exists, This.Open() && open Installer Endif _app.Path = This.Path *----------------------------------------------------------------------- * StartPathErr - This procedure sets the StartPathIsOK * property to false if the CD command produces an * error. You can expand this, if you like, to determine * the exact nature of the error and produce an alert * box to warn the user. *-------------------------------------------------------------------- Procedure StartPathErr This.StartPathIsOk = .f. *----------------Initialize and open Net Install form Procedure Open if Type('This.aFiles') # 'A' This.aFiles = This.FillArray() endif this.NetWin = New NetForm() this.NetWin.oNetRef = this this.NetWin.ReadModal() This.NetWin.release() This.NetWin = '' *----------------Validates typed-in drive letter Function CheckDrive if .not. validdrive(trim(this.NetWin.drivefield.value)) MsgBox('Drive letter is not valid','Install Error',16) return .f. endif return .t. *----------------Validates typed-in directory Function CheckDir Private cTestDir,cOldDir cTestDir = substr(this.NetWin.Drivefield.value,1,1)+':'; +trim(this.NetWin.Dirfield.value) &&init directory path if cTestDir = substr(this.NetWin.Drivefield.value,1,1)+':\'; .and. len(trim(cTestDir)) = 3 &&If root was selected msgbox('Cannot install to root.','Directory Error',0) This.DirIsOk = .f. &&No good, go back return .f. endif This.DirIsOk = .t. cOldDir = SET("DIRECTORY") &&Store current directory ON Error This.DirErr(cTestDir,4) &&Set error in case of failure CD &cTestDir &&Try to change directory On Error &&Reset error cd &cOldDir &&Go back to old directory return this.DirIsOk *------------------------Handles CD Error * Recovery includes Make Directory Function DirErr(cDirStr) &&Param is typed-in drive/directory Local nWhatToDo &&Init msgbox selection var nWhatToDo = MsgBox(cDirStr+' does not exist. Create it?','Directory',20) if nWhatToDo = 6 &&If users clicks "OK" This.DirIsOk = .t. On Error This.MakeDirErr(cDirStr) &&Make Directory Recovery MakeStr = 'MD '+cDirStr &MakeStr &&Create missing directory &&MD &cDirStr On Error else this.DirIsOk = .f. &&If not OK, drive/dir failed endif Return this.DirIsOk *----------------Error handler for Make Dir failure Procedure MakeDirErr(cDIrStr) MsgBox('Cannot create '+cDirStr,'Directory Error',0) this.DirIsOk = .f. &&Set flag for failure Procedure PathSet(f) This.Path = Substr(f.Drivefield.Value,1,1)+':'+; trim(f.Dirfield.Value) If substr(This.path,len(This.Path),1) # '\' This.path = This.Path+'\' Endif *------------------------------------------------------------------------------------ FUNCTION FillArray * This function will extract the names of files with a filename * extension of `DBF' and return those filenames in an array. *----------------------------------------------------------------------------------- Local n Private aFiles aFiles = This.ExtractFilenames(This.cExe) &&Call the extraction routine If Type("aFiles") == "A" && If filenames extracted successfully aMatchFiles = New Array(0) &&Create a new array. For n = 1 To aFiles.Size &&Sequence through all filenames &&in the original array. If Upper(Right(aFiles[n],3)) == 'DBF' aMatchFiles.Add(aFiles[n]) &&Add only if names &&have correct exension EndIf EndFor Else &&If filename extraction didn't work Return 0 EndIf &&If it worked, return reference &&to the array with filenames. RETURN aMatchFiles *------------------------------------------------------------- FUNCTION ExtractFilenames(cEXEName) * This function extracts the name of * files "packaged" into the .EXE * The original code for this extraction program was * created and written by Jim Sare who is now a * member of TeamB. The genius is his, any * errors are mine! AAK *------------------------------------------------------------ LOCAL hModule, hResInfo, hResourceHandle,; nBuffSize, nResourceString, cBuff *WIN API functions must be Prototyped before *being called. If Type("FindResource") # "FP" extern CHANDLE FindResource(CHANDLE, CPTR, CLONG) Kernel EndIf #define RT_RCDATA 10 If Type("FreeResource") # "FP" extern CINT FreeResource(CHANDLE) Kernel EndIf If Type("GetModuleHandle") # "FP" extern CHANDLE GetModuleHandle(CPTR) Kernel EndIf If Type("GlobalUnlock") # "FP" extern CINT GlobalUnlock(CHANDLE) Kernel EndIf If Type("hmemcpy") # "FP" extern CVOID hmemcpy(CPTR, CLONG, CLONG) Kernel EndIf If Type("LoadResource") # "FP" extern CHANDLE LoadResource(CHANDLE, CHANDLE) Kernel EndIf If Type("LockResource") # "FP" extern CLONG LockResource(CHANDLE) Kernel EndIf If Type("SizeOfResource") # "FP" extern CWORD SizeOfResource(CHANDLE, CHANDLE) Kernel EndIf &&Get module handle of the .EXE &&Specified hModule = GetModuleHandle(This.cExe) If hModule > 0 &&If Exe's Handle found hResInfo = FindResource(hModule, "#32767" + Chr(0), RT_RCDATA) If hResInfo > 0 &&If filename resources found hResourceHandle = LoadResource(hModule, hResInfo) If hResourceHandle > 0 &&if resource was loaded nBuffSize = SizeOfResource(hModule, hResInfo) If nBuffSize > 0 &&if buffersize is ok hResString = LockResource(hResourceHandle) If hResString > 0 &&if resource string available cBuff = Space(nBuffSize + 1) &© the resource string to the buffer hmemcpy(cBuff, hResString, nBuffSize) GlobalUnlock(hResourceHandle) FreeResource(hResourceHandle) Else &&if no string, free up resources FreeResource(hResourceHandle) Return -5 && Lock failed EndIf Else Return - 4 &&No names in resource Endif Else Return -3 && Load failed (insufficient memory) EndIf Else Return -2 && Filename Resource not found EndIf Else Return -1 &&Exe filename is wrong EndIf Return This.MakeStrings(SubStr(cBuff, 2,At(Chr(0) ; + Chr(0), cBuff)), Chr(0)) &&Clean up the buffer for VdB *------------------------------------------------------------------- FUNCTION MakeStrings(cBuff, cDelim) * Reformat strings from buffer for use *in the array. Local nLen, nStart, nEnd, aRet aRet = New Array(0) && Initialize array to receive strings nStart = 1 nLen = Len(cBuff) Do && Break returned string into individual key names nEnd = At(cDelim, cBuff, aRet.Size + 1) aRet.Add(SubStr(cBuff, nStart, nEnd - nStart)) nStart = nEnd + 1 Until nStart => nLen Return aRet EndClass &&EOC ** END HEADER -- do not remove this line* * Generated on 07/22/95 * CLASS NETFORM OF FORM this.OnOpen = CLASS::FORM_ONOPEN this.Text = "Setup" this.Left = 18.666 this.Top = 0.1758 this.Width = 61.333 this.Height = 7.9404 this.MDI = .F. this.Sizeable = .F. this.Maximize = .F. DEFINE RECTANGLE RECTANGLE1 OF THIS; PROPERTY; Text "",; Left 3.5,; Top 2,; Width 53.8311,; BorderStyle 2,; Height 3.4697 DEFINE TEXT TEXT1 OF THIS; PROPERTY; Text "Path to Shared Data Files:",; Left 6.8311,; Top 2.5293,; Width 22.5,; Height 0.7637,; FontBold .F. DEFINE TEXT TEXT4 OF THIS; PROPERTY; Text "Drive",; Left 6.8311,; Top 3.5879,; Width 5.5,; Height 0.7637 DEFINE ENTRYFIELD DRIVEFIELD OF THIS; PROPERTY; Value "C",; Left 13.6641,; Top 3.4688,; Width 3,; Height 1 DEFINE TEXT TEXT3 OF THIS; PROPERTY; Text "Directory",; Left 18.3311,; Top 3.5879,; Width 8.667,; Height 0.7637 DEFINE ENTRYFIELD DIRFIELD OF THIS; PROPERTY; MaxLength 35,; Value "\",; Picture "\XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX",; Left 27.5,; Top 3.4688,; Width 27.1641,; Height 1,; SelectAll .F.,; ColorHighLight "W+/N+" DEFINE PUSHBUTTON OKBUTTON OF THIS; PROPERTY; Group .T.,; Text "&OK",; Left 31.833,; Top 5.8818,; Width 11.833,; Height 1.1182,; OnClick CLASS::OKBUTTON_ONCLICK,; FontBold .F. DEFINE PUSHBUTTON CANCELBUTTON OF THIS; PROPERTY; Group .T.,; Text "&Cancel",; Left 45.166,; Top 5.8818,; Width 11.834,; Height 1.1182,; OnClick CLASS::CANCELBUTTON_ONCLICK,; FontBold .F. DEFINE TEXT TEXT2 OF THIS; PROPERTY; Text "Network Setup",; Left 2.6641,; Top 0.1172,; Width 27.834,; Height 1.3516,; FontSize 14,; FontItalic .T.,; ColorNormal "R/W" PROCEDURE Form_OnOpen Form.TestServerFile = 'InOrder.dbf' Form.PathIsSet = .f. PROCEDURE OKButton_OnClick if .not. form.oNetRef.CheckDrive() Form.DriveField.SetFocus() Return Elseif .not. form.oNetref.CheckDir() form.dirfield.SetFocus() Return Endif Form.oNetRef.PathSet(Form) m_path = Form.oNetRef.Path if .not. file(m_path+Form.oNetRef.TestServerFile) Set Safety Off save all like m_path to path Set Safety ON if .not. CLASS::Copyform() Return Endif Else Set Safety Off save all like m_path to path Set Safety On Endif form.Close() Procedure CANCELBUTTON_OnClick m_path = ' ' Set Safety Off Save all like m_path to Path.mem Set Safety On Quit Procedure CopyForm If aLen(Form.oNetRef.aFiles,1) > 0 &&if there is a list Local f f = New FcopyForm() f.oNetRef = Form.oNetRef f.aFiles = Form.oNetref.aFiles f.DirLabel.text = '' f.mdi = .f. f.Cancel = .f. f.ReadModal() Form.Cancel = f.Cancel f.Release() f = '' if Form.Cancel Return .f. endif endif return .t. ENDCLASS ********************************************************** *---------class to display and copy files CLASS FCOPYFORM OF FORM this.Text = "Install Empty Tables" this.Left = 23 this.Top = 2 this.Width = 60 this.Height = 10.5879 this.MDI = .F. DEFINE RECTANGLE RECTANGLE1 OF THIS; PROPERTY; Text "Rectangle1",; Left 3.832,; Top 0.9395,; Width 52.834,; BorderStyle 1,; Height 6.4697 DEFINE RECTANGLE RECTANGLE2 OF THIS; PROPERTY; Text "Rectangle2",; Left 9.665,; Top 3.0586,; Width 41.335,; BorderStyle 2,; Height 1.9404 DEFINE TEXT FILELABEL OF THIS; PROPERTY; FontSize 12,; FontItalic .T.,; Text "Copy new tables to server...",; Left 11.832,; Top 3.3516,; Width 37.168,; Height 1.1768,; ColorNormal "R/BtnFace" DEFINE TEXT COPYLABEL OF THIS; PROPERTY; FontSize 10,; FontItalic .T.,; Visible .F.,; Text "Copying",; Left 10,; Top 1.6465,; Width 13.5,; Height 0.9404 DEFINE TEXT DIRLABEL OF THIS; PROPERTY; Visible .F.,; Text "To ",; Left 10,; Top 5.6465,; Width 40.5,; Height 0.9404 DEFINE PUSHBUTTON CONTINUEBUTTON OF THIS; PROPERTY; Group .T.,; Text "&OK",; Left 27.5,; Top 8.0586,; Width 14.166,; Height 1.1172,; OnClick CLASS::FORM_COPYFILES,; ColorNormal "N/W",; FontBold .F. DEFINE PUSHBUTTON CANCELBUTTON OF THIS; PROPERTY; Group .T.,; Text "&Cancel",; Left 42.666,; Top 8.0586,; Width 14.167,; Height 1.1172,; OnClick CLASS::CANCELBUTTON_ONCLICK,; ColorNormal "N/W",; FontBold .F. PROCEDURE FORM_CopyFiles Form.Dirlabel.Visible = .t. Form.CopyLabel.Visible = .t. Local cTestName,n For n= 1 to alen(Form.oNetRef.aFiles,1) &&do while anything is left cTestName = Form.oNetRef.Afiles[n] If at('.',cTestName) > 0 cTestName = Substr(cTestname,1,at('.',cTestname)-1) Endif if file(Form.oNetRef.path+cTestName+'.dbf') if msgbox('File '+cTestName+'.DBF already exists, Overwrite?','File Copy',52) = 7 form.cancel = .f. form.close() endif endif form.FileLabel.Text = cTestName+'.dbf' Set Safety Off if file(cTestName+'.dbf',.t.) &&if exist, copy .mdx Use Copy file (cTestName+'.dbf') to; (Form.oNetRef.Path+cTestname+'.dbf') endif if file(cTestName+'.mdx',.t.) &&if exist, copy .mdx Copy file (cTestName+'.mdx') to; (Form.oNetRef.Path+cTestname+'.mdx') endif if file(cTestName+'.dbt',.t.) &&if exist, copy .mdx Copy file (cTestName+'.dbt') to; (Form.oNetRef.Path+cTestname+'.dbt') endif Set Safety On Next form.cancel = .f. form.close() PROCEDURE CANCELBUTTON_OnClick form.cancel = .t. form.close() ENDCLASS