home *** CD-ROM | disk | FTP | other *** search
/ SuperHack / SuperHack CD.bin / CODING / VBASIC / VB42VB3.ZIP / GLOBAL.BAS < prev    next >
Encoding:
BASIC Source File  |  1996-02-22  |  16.1 KB  |  492 lines
  1. Option Explicit
  2.  
  3. ' globals for vb4-3 converter
  4.  
  5. Global iDoWhat%, Aborted%
  6. Global sFileIn$, sFileOut$
  7. Global sPathIn$
  8.  
  9. Global ssFind$(), ssReplace$(), ssKillLine$(), ssKill$()
  10.  
  11. Global ssProperty$
  12.  
  13. Dim sFiles$(), sFileOnly$()
  14. Dim sProject$
  15. Dim sProjectPath$, sTranslatePath$
  16. Dim iForm%
  17.  
  18. Sub ConvertProject (f As Form)   ' processes project-files
  19.     On Error Resume Next
  20.     
  21.     On Error Resume Next
  22.     Dim s$, sWhat$, sRest$, sDrv$, sPath$, sFile$
  23.     Dim iMax%, i%, j%, k%, sOutProj$
  24.     
  25.     sProject = sFileIn
  26.     Aborted = False
  27.     
  28.     Call MakeFilePath(sFileIn, sDrv, sPath, sFile)
  29.     ReDim sFiles(0), sFileOnly(0)
  30.     
  31.     sProjectPath = sDrv & sPath
  32.     
  33.     sTranslatePath = sProjectPath & "VB3" & "\"      ' new project path
  34.     MkDir Left(sTranslatePath, Len(sTranslatePath) - 1) ' MKDir
  35.     Err = 0
  36.     
  37.     Close #2 ' just in case it was open ... else error, but who cares
  38.     Err = 0
  39.  
  40.     sOutProj = sTranslatePath & sFile
  41.     sOutProj = Left(sOutProj, Len(sOutProj) - 3) & "MAK"
  42.     Open sOutProj For Output As #2
  43.     
  44.     Open sProject For Input As #1
  45.     Do While Not EOF(1)
  46.         Line Input #1, s
  47.         i = InStr(s, "=")
  48.         If i <> 0 Then
  49.             sWhat = Left(s, i - 1)
  50.             sRest = Mid(s, i + 1)
  51.             Select Case sWhat
  52.                 Case "Form"
  53.                     iMax = UBound(sFiles)
  54.                     ReDim Preserve sFiles(iMax + 1)
  55.                     ReDim Preserve sFileOnly(iMax + 1)
  56.                     sFiles(iMax + 1) = MakePath(sRest, sProjectPath)
  57.                     sFileOnly(iMax + 1) = GetFilename(sRest)
  58.                     Print #2, sFileOnly(iMax + 1)
  59.                     
  60.                 Case "Module"
  61.                     i = InStr(sRest, ";")
  62.                     
  63.                     sFile = Mid(sRest, i + 1)
  64.                     
  65.                     iMax = UBound(sFiles)
  66.                     ReDim Preserve sFiles(iMax + 1)
  67.                     ReDim Preserve sFileOnly(iMax + 1)
  68.                     
  69.                     sFiles(iMax + 1) = MakePath(sFile, sProjectPath)
  70.                     sFileOnly(iMax + 1) = GetFilename(sFile)
  71.                     
  72.                     Print #2, Trim(GetFilename(sFile))
  73.                     
  74.                 Case "VBX"
  75.                     i = InStr(sRest, ";")
  76.                     sFile = Mid(sRest, i + 1)
  77.                     Print #2, Trim(GetFilename(sFile))
  78.                     
  79.                 Case "Reference"
  80.                 Case "VersionCompatible"
  81.                 Case "MajorVer"
  82.                 Case "MinorVer"
  83.                 Case "RevisionVer"
  84.                 Case "AutoIncrementVer"
  85.                 Case "ServerSupportFiles"
  86.                 Case "VersionCompanyName"
  87.                 Case "VersionFileDescription"
  88.                 Case "VersionLegalCopyright"
  89.                 Case "VersionProductName"
  90.                 Case "ExeName"
  91.                 Case "StartMode"
  92.                 Case "ProductName"
  93.                 Case "Name"
  94.                 Case "HelpFile"
  95.                 Case "HelpContextID"
  96.                 Case "Description"
  97.                     ' don't copy these
  98.                 
  99.                 Case "Object" ' convert OCXes
  100.                     i = InStr(sRest, ";")
  101.                     sFile = Trim(GetFilename(Mid(sRest, i + 1)))
  102.                     Select Case sFile
  103.                         Case "COMDLG16.OCX": sFile = "CMDIALOG.VBX"
  104.                         Case "MSMASK16.OCX": sFile = "MSMASKED.VBX"
  105.                         Case "MSCOMM16.OCX": sFile = "MSCOMM.VBX"
  106.                         Case "THREED16.OCX": sFile = "THREED.VBX"
  107.                         Case "TABCTL16.OCX": sFile = "" ' TAB's must be redone
  108.                         Case "GAUGE16.OCX": sFile = "GAUGE.VBX"
  109.                         Case "KEYSTA16.OCX": sFile = "KEYSTAT.VBX"
  110.                         Case "PICCLP16.OCX": sFile = "PICCLIP.VBX"
  111.                         Case "SPIN16.OCX": sFile = "SPIN.VBX"
  112.                         Case "MCI16.OCX": sFile = "MCI.VBX"
  113.                         Case "GRAPH16.OCX": sFile = "GRAPH.VBX"
  114.                         Case Else: sFile = ""
  115.                     End Select
  116.                     
  117.                     If sFile <> "" Then Print #2, "C:\WINDOWS\SYSTEM\" & sFile
  118.                     
  119.                 Case Else
  120.                     Print #2, s
  121.             End Select
  122.         Else
  123.             Print #2, s
  124.         End If
  125.     Loop
  126.     Close #1
  127.     Close #2
  128.     
  129.     For i = 1 To UBound(sFiles)
  130.         f!lblProz = Str(Fix((i / UBound(sFiles)) * 100)) & " %"
  131.         f!lblAnz = Str(i) & " / " & UBound(sFiles)
  132.         Call Research(sFiles(i), f)
  133.         DoEvents
  134.         If Aborted Then Exit For
  135.     Next i
  136.  
  137.     DoEvents
  138.     
  139.     Unload f
  140. End Sub
  141.  
  142. Function ProcessLine$ (s$)
  143.     On Error Resume Next
  144.     Dim s1$, s2$
  145.     Dim i%
  146.     
  147.     s1 = s
  148.     s2 = ssCheckProperty(s1)
  149.     s1 = s2
  150.     s2 = ssCheckReplace(s1)
  151.     s1 = s2
  152.     s2 = ssCheckKillLine(s1)
  153.     s1 = s2
  154.     s2 = ssCheckRest(s1)
  155.     s1 = s2
  156.     
  157.     If iForm = 1 Then
  158.         i = InStr(s1, "VB.")
  159.         If i > 0 Then
  160.             s2 = Left(s1, i - 1) & Mid(s1, i + 3)
  161.             s1 = s2
  162.         End If
  163.  
  164.         i = InStr(s1, "VBX.")
  165.         If i > 0 Then
  166.             s2 = Left(s1, i - 1) & Mid(s1, i + 4)
  167.             s1 = s2
  168.         End If
  169.     End If
  170.  
  171.     ProcessLine = s1
  172. End Function
  173.  
  174. Sub Research (sFile$, f As Form)
  175.     On Error Resume Next
  176.     Dim s$, strIn$, strOut$, sD$, sp$, sF$, iCnt&
  177.     
  178.     Call ssEinrichten
  179.     
  180.     f!lblDatei = sFile
  181.     f!lblLine = ""
  182.     
  183.     Call MakeFilePath(sFile, sD, sp, sF)
  184.     
  185.     sPathIn = sD & sp
  186.     sFileOut = sTranslatePath & sF
  187.     
  188.     Open sFile For Input As #1
  189.     Open sFileOut For Output As #2
  190.     
  191.     iCnt = 0
  192.     If UCase(Right(sF, 3)) = "FRM" Then iForm = 1
  193.  
  194.     Do While (Not EOF(1)) And (Not Aborted)
  195.         Line Input #1, strIn
  196.  
  197.         If strIn = "End" Then iForm = 0 ' end of Form-Structure
  198.  
  199.         Do While Right(Trim(strIn), 1) = "_"
  200.             Line Input #1, s
  201.             strIn = Left(RTrim(strIn), Len(RTrim(strIn)) - 1) & " " & LTrim(s)
  202.         Loop
  203.         strOut = ProcessLine(strIn)
  204.         Print #2, strOut
  205.         
  206.         iCnt = iCnt + 1
  207.         If Rnd > .9 Then f!lblLine = iCnt: DoEvents
  208.     Loop
  209.     
  210.     Close #1
  211.     Close #2
  212.     
  213.     ' copy FRX-File
  214.     
  215.     s = Left(sFile, Len(sFile) - 1) & "x"
  216.     FileCopy s, Left(sFileOut, Len(sFileOut) - 1) & "x"
  217.     Err = 0
  218.     
  219. End Sub
  220.  
  221. Sub ssAddKillLine (s1$)
  222.     On Error Resume Next
  223.     Dim i%
  224.     i = UBound(ssKillLine) + 1
  225.     ReDim Preserve ssKillLine(i)
  226.     
  227.     ssKillLine(i) = s1
  228. End Sub
  229.  
  230. Sub ssAddReplace (s1$, s2$)
  231.     On Error Resume Next
  232.     Dim i%
  233.     i = UBound(ssFind) + 1
  234.     ReDim Preserve ssFind(i), ssReplace(i)
  235.     
  236.     ssFind(i) = s1: ssReplace(i) = s2
  237. End Sub
  238.  
  239. Function ssCheckKillLine$ (s$)
  240.     On Error Resume Next
  241.     Dim s1$, i%
  242.     
  243.     s1 = s$
  244.     For i = 1 To UBound(ssKillLine)
  245.         If Left(Trim(s), Len(ssKillLine(i))) = ssKillLine(i) Then s1 = "": Exit For
  246.     Next i
  247.     ssCheckKillLine = s1
  248. End Function
  249.  
  250. Function ssCheckProperty$ (strIn$)
  251.     On Error Resume Next
  252.     Dim i%, strOut$, ss$
  253.     
  254.     strOut = strIn
  255.     If ssProperty = "" Then ' Property-Structures changed
  256.         ss = "BeginProperty"
  257.         If Left(Trim(strIn), Len(ss)) = ss Then
  258.             i = InStr(strIn, ss)
  259.             ssProperty = Trim(Mid(strIn, i + Len(ss)))
  260.             i = InStr(ssProperty, "{")
  261.             If i > 0 Then
  262.                 ssProperty = Trim(Left(ssProperty, i - 1))
  263.             End If
  264.             strOut = ""
  265.         End If
  266.     Else
  267.         If Trim(strIn) = "EndProperty" Then
  268.             ssProperty = ""
  269.             strOut = ""
  270.         Else
  271.             i = InStr(strOut, "}")
  272.             If i > 0 Then
  273.                 strOut = Mid(strOut, i + 1)
  274.             End If
  275.             strOut = Space(Len(strOut) - Len(Trim(strOut))) & ssProperty & Trim(strOut)
  276.         End If
  277.     End If
  278.     ssCheckProperty = strOut
  279. End Function
  280.  
  281. Function ssCheckReplace$ (strIn$)
  282.     On Error Resume Next
  283.     Dim s1$, s2$, i%, i1%, i2%
  284.     
  285.     s1 = strIn
  286.    
  287.     For i = 1 To UBound(ssFind)
  288.         i1 = InStr(s1, ssFind(i))
  289.         If i1 > 0 Then
  290.             s2 = Left(s1, i1 - 1) & ssReplace(i) & Mid(s1, i1 + Len(ssFind(i)))
  291.             s1 = s2
  292.         End If
  293.     Next i
  294.     ssCheckReplace = s1
  295. End Function
  296.  
  297. Function ssCheckRest$ (strIn$)
  298.     On Error Resume Next
  299.     Dim i%, i1%, ss$, strOut$
  300.     Dim sFile$, iPos&, iLen%, s1$, s2$
  301.     
  302.     strOut = strIn
  303.     
  304.     ' Fontweight changed into Fontbold
  305.  
  306.     If UCase(Left(Trim(strIn), 10)) = UCase("Fontweight") Then
  307.         i = Val(Mid(strIn, InStr(strIn, "=") + 1))
  308.         If i > 400 Then
  309.             strOut = Space(Len(strIn) - Len(Trim(strIn))) & "Fontbold = -1 ' True"
  310.         Else
  311.             strOut = Space(Len(strIn) - Len(Trim(strIn))) & "Fontbold = 0 ' False"
  312.         End If
  313.     End If
  314.     
  315.     ss = ".FRX"":"
  316.     i = InStr(UCase(strOut), ss)
  317.     If i > 0 Then
  318.         i = InStr(strOut, "$""")
  319.         If i > 0 Then   ' convert FRX-Entry to String
  320.             i1 = InStr(i + 2, strOut, """")
  321.             sFile = Mid(strOut, i + 2, (i1 - i) - 2)
  322.             iPos = CLng("&H" & Trim(Mid(strOut, InStr(strOut, ":") + 1))) + 1
  323.             
  324.             Open sPathIn & sFile For Binary Access Read As #4
  325.             s1 = Space(1): s2 = Space(1)
  326.             Get #4, iPos, s1
  327.             Get #4, iPos + 1, s2
  328.             iLen = Asc(s2) * 256 + Asc(s1)
  329.             ss = Space(iLen)
  330.             Get #4, iPos + 4, ss
  331.             Close #4
  332.             ss = ssCleanString(ss)
  333.             strOut = Left(strOut, i - 1) & """" & ss & """"
  334.             
  335.         Else
  336.             i = InStr(strOut, """")
  337.             If i > 0 Then strOut = Left(strOut, i - 1) & Mid(strOut, i + 1)
  338.             i = InStr(strOut, """")
  339.             If i > 0 Then strOut = Left(strOut, i - 1) & Mid(strOut, i + 1)
  340.         End If
  341.     End If
  342.     
  343.     ssCheckRest = strOut
  344. End Function
  345.  
  346. Function ssCleanString$ (s$)
  347.     On Error Resume Next
  348.     Dim i%, ss$, s1$
  349.     ss = ""
  350.     For i = 1 To Len(s)
  351.         s1 = Mid(s, i, 1)
  352.         If Asc(s1) >= 32 Then ss = ss & s1
  353.     Next i
  354.     ssCleanString = ss
  355. End Function
  356.  
  357. Sub ssEinrichten ()
  358.     On Error Resume Next
  359.     
  360.     ReDim ssFind(0), ssReplace(0), ssKillLine(0), ssKill(0)
  361.     
  362.     Call ssAddReplace("MSMask.MaskEdBox", "MaskEdBox")
  363.     
  364.     Call ssAddReplace("VB.CheckBox", "SSCheck") ' VB4-Controls in 3D
  365.     Call ssAddReplace("VB.CommandButton", "CommandButton")
  366.     Call ssAddReplace("VB.CommonDialog", "CommonDialog")
  367.     Call ssAddReplace("VB.Data", "Data")
  368.     Call ssAddReplace("VB.Form", "Form")
  369.     Call ssAddReplace("VB.Frame", "SSFrame")
  370.     Call ssAddReplace("VB.Image", "Image")
  371.     Call ssAddReplace("VB.Label", "Label")
  372.     Call ssAddReplace("VB.Line", "Line")
  373.     Call ssAddReplace("VB.ListBox", "ListBox")
  374.     Call ssAddReplace("VB.MDIForm", "MDIForm")
  375.     Call ssAddReplace("VB.Menu", "Menu")
  376.     Call ssAddReplace("VB.OptionButton", "SSOption")
  377.     Call ssAddReplace("VB.PictureBox", "PictureBox")
  378.     Call ssAddReplace("VB.TextBox", "TextBox")
  379.     Call ssAddReplace("VB.Timer", "Timer")
  380.     Call ssAddReplace("MSCommLib.MSComm", "MSComm")
  381.     
  382.     Call ssAddReplace("VBX.CSCLOCK", "CSCLOCK") ' add all used VBX's here
  383.     Call ssAddReplace("VBX.CSCalendar", "CSCalendar")
  384.     Call ssAddReplace("VBX.CSComboBox", "CSComboBox")
  385.     Call ssAddReplace("VBX.CSMeter", "CSMeter")
  386.     Call ssAddReplace("VBX.CSOptList", "CSOptList")
  387.     Call ssAddReplace("VBX.sivbLB", "sivbLB")
  388.     Call ssAddReplace("VBX.sicrEdit", "sicrEdit")
  389.     Call ssAddReplace("VBX.sidtEdit", "sidtEdit")
  390.     Call ssAddReplace("VBX.silgEdit", "silgEdit")
  391.     Call ssAddReplace("VBX.sidbEdit", "sidbEdit")
  392.     Call ssAddReplace("VBX.sitxEdit", "sitxEdit")
  393.     Call ssAddReplace("VBX.TrueGrid", "TrueGrid")
  394.     Call ssAddReplace("VBX.HEVBLayer", "HEVBLayer")
  395.     Call ssAddReplace("VBX.Mh3dGauge", "Mh3dGauge")
  396.     
  397.     Call ssAddReplace("Threed.SSCheck", "SSCheck")
  398.     Call ssAddReplace("Threed.SSCommand", "SSCommand")
  399.     Call ssAddReplace("Threed.SSFrame", "SSFrame")
  400.     Call ssAddReplace("Threed.SSOption", "SSOption")
  401.     Call ssAddReplace("Threed.SSPanel", "SSPanel")
  402.     
  403.     Call ssAddReplace("VERSION 4.00", "VERSION 2.00")
  404.     
  405.     Call ssAddReplace("DBEngine.Idle dbFreeLocks", "FreeLocks") ' VB4 Code
  406.     Call ssAddReplace(" As Boolean", " As Integer")          ' Data types
  407.     Call ssAddReplace(" As Date", " As Long")
  408.     Call ssAddReplace("App.Path()", "App.Path")
  409.  
  410.     Call ssAddReplace("vbKeyEscape", "KEY_ESCAPE") ' VB4 Constants
  411.     Call ssAddReplace("vbKeyTab", "KEY_TAB")
  412.     Call ssAddReplace("vbKeyShift", "KEY_SHIFT")
  413.     Call ssAddReplace("vbKeyControl", "KEY_CONTROL")
  414.     Call ssAddReplace("vbKeyReturn", "KEY_RETURN")
  415.     Call ssAddReplace("vbKeyHome", "KEY_HOME")
  416.     Call ssAddReplace("vbKeyEnd", "KEY_END")
  417.     Call ssAddReplace("vbKeyDown", "KEY_DOWN")
  418.     Call ssAddReplace("vbKeyUp", "KEY_UP")
  419.     Call ssAddReplace("vbKeySpace", "KEY_SPACE")
  420.     Call ssAddReplace("vbKeyInsert", "KEY_INSERT")
  421.     Call ssAddReplace("vbKeyDelete", "KEY_DELETE")
  422.  
  423.     Call ssAddReplace("vbHourglass", "HOURGLASS")
  424.     Call ssAddReplace("vbDefault", "DEFAULT")
  425.     Call ssAddReplace("vbYesNo", "MB_YESNO")
  426.     Call ssAddReplace("vbYesNoCancel", "MB_YESNOCANCEL")
  427.     Call ssAddReplace("vbOKOnly", "MB_OK")
  428.     Call ssAddReplace("vbOKCancel", "MB_OKCANCEL")
  429.     Call ssAddReplace("vbRetryCancel", "MB_RETRYCANCEL")
  430.     Call ssAddReplace("vbAbortRetryIgnore", "MB_ABORTRETRYIGNORE")
  431.     Call ssAddReplace("vbCritical", "MB_ICONSTOP")
  432.     Call ssAddReplace("vbQuestion", "MB_ICONQUESTION")
  433.     Call ssAddReplace("vbExclamation", "MB_ICONEXCLAMATION")
  434.     Call ssAddReplace("vbInformation", "MB_ICONINFORMATION")
  435.     Call ssAddReplace("vbCritical", "MB_ICONSTOP")
  436.     Call ssAddReplace("vbDefaultButton1", "MB_DEFBUTTON1")
  437.     Call ssAddReplace("vbDefaultButton2", "MB_DEFBUTTON2")
  438.     Call ssAddReplace("vbDefaultButton3", "MB_DEFBUTTON3")
  439.     Call ssAddReplace("vbApplicationModal", "MB_APPLMODAL")
  440.     Call ssAddReplace("vbSystemModal", "MB_SYSTEMMODAL")
  441.     Call ssAddReplace("vbOK", "IDOK")
  442.     Call ssAddReplace("vbYes", "IDYES")
  443.     Call ssAddReplace("vbNo", "IDNO")
  444.     Call ssAddReplace("vbCancel", "IDCANCEL")
  445.     Call ssAddReplace("vbRetry", "IDRETRY")
  446.     Call ssAddReplace("vbIgnore", "IDIGNORE")
  447.     Call ssAddReplace("vbBlack", "BLACK")
  448.     Call ssAddReplace("vbRed", "RED")
  449.     Call ssAddReplace("vbGreen", "GREEN")
  450.     Call ssAddReplace("vbYellow", "YELLOW")
  451.     Call ssAddReplace("vbBlue", "BLUE")
  452.     Call ssAddReplace("vbMagenta", "MAGENTA")
  453.     Call ssAddReplace("vbCyan", "CYAN")
  454.     Call ssAddReplace("vbWhite", "WHITE")
  455.     Call ssAddReplace("dbLong", "DB_LONG")
  456.     Call ssAddReplace("dbText", "DB_TEXT")
  457.     Call ssAddReplace("dbDouble", "DB_DOUBLE")
  458.     Call ssAddReplace("dbInteger", "DB_INTEGER")
  459.     Call ssAddReplace("dbSingle", "DB_SINGLE")
  460.     Call ssAddReplace("dbDate", "DB_DATE")
  461.     Call ssAddReplace("dbMemo", "DB_MEMO")
  462.     Call ssAddReplace("dbLangGeneral", "DB_LANG_GENERAL")
  463.     Call ssAddReplace("dbLangSpanish", "DB_LANG_SPANISH")
  464.     Call ssAddReplace("dbLangDutch", "DB_LANG_DUTCH")
  465.     Call ssAddReplace("dbEncrypt", "DB_ENCRYPT")
  466.     Call ssAddReplace("dbVersion10", "DB_VERSION10")
  467.     Call ssAddReplace("dbVersion11", "DB_VERSION10")
  468.     Call ssAddReplace("dbVersion20", "DB_VERSION10")
  469.     Call ssAddReplace("dbVersion25", "DB_VERSION10")
  470.  
  471.     Call ssAddKillLine("Attribute VB_")
  472.     Call ssAddKillLine("Appearance")
  473.     Call ssAddKillLine("Fontcharset")
  474.     Call ssAddKillLine("fontcharset")
  475.     Call ssAddKillLine("Fontstrikethrough")
  476.     Call ssAddKillLine("fontstrikethrough")
  477.     Call ssAddKillLine("Icon")
  478.     Call ssAddKillLine("ShowInTaskbar")
  479.     Call ssAddKillLine("_stockprops")
  480.     Call ssAddKillLine("_version")
  481.     Call ssAddKillLine("_extentx")
  482.     Call ssAddKillLine("_extenty")
  483.     Call ssAddKillLine("RecordsetType")
  484.     
  485.     Call ssAddReplace("Private ", "") ' just remove text and leave rest
  486.     Call ssAddReplace("Public ", "Dim ")
  487.     
  488.     ssProperty = ""
  489.     
  490. End Sub
  491.  
  492.