home *** CD-ROM | disk | FTP | other *** search
/ Hot Shareware 35 / hot35.iso / ficheros / LVB / T2W32543.ZIP / _REGISTR.FRM < prev    next >
Text File  |  1998-05-21  |  15KB  |  367 lines
  1. VERSION 5.00
  2. Begin VB.Form frmRegistry 
  3.    BorderStyle     =   4  'Fixed ToolWindow
  4.    Caption         =   "Registry"
  5.    ClientHeight    =   4845
  6.    ClientLeft      =   1890
  7.    ClientTop       =   3270
  8.    ClientWidth     =   7485
  9.    MaxButton       =   0   'False
  10.    MDIChild        =   -1  'True
  11.    PaletteMode     =   1  'UseZOrder
  12.    ScaleHeight     =   4845
  13.    ScaleWidth      =   7485
  14.    ShowInTaskbar   =   0   'False
  15.    Begin VB.Frame Frame1 
  16.       Height          =   570
  17.       Left            =   0
  18.       TabIndex        =   1
  19.       Top             =   -90
  20.       Width           =   7485
  21.       Begin VB.CommandButton cmdNP 
  22.          Caption         =   ">"
  23.          Height          =   285
  24.          Index           =   1
  25.          Left            =   7110
  26.          TabIndex        =   6
  27.          Top             =   195
  28.          Width           =   285
  29.       End
  30.       Begin VB.CommandButton cmdNP 
  31.          Caption         =   "<"
  32.          Height          =   285
  33.          Index           =   0
  34.          Left            =   6210
  35.          TabIndex        =   5
  36.          Top             =   195
  37.          Width           =   285
  38.       End
  39.       Begin VB.CommandButton Command1 
  40.          Caption         =   "&Go"
  41.          Default         =   -1  'True
  42.          Height          =   285
  43.          Left            =   6570
  44.          TabIndex        =   4
  45.          Top             =   195
  46.          Width           =   465
  47.       End
  48.       Begin VB.ComboBox cmb_Function 
  49.          Height          =   315
  50.          Left            =   1365
  51.          TabIndex        =   2
  52.          Top             =   180
  53.          Width           =   4755
  54.       End
  55.       Begin VB.Label Label2 
  56.          Caption         =   "&Select a function"
  57.          Height          =   255
  58.          Left            =   90
  59.          TabIndex        =   3
  60.          Top             =   210
  61.          Width           =   1275
  62.       End
  63.    End
  64.    Begin VB.TextBox txt_Result 
  65.       BackColor       =   &H00C0C0C0&
  66.       BorderStyle     =   0  'None
  67.       Height          =   4110
  68.       Left            =   105
  69.       Locked          =   -1  'True
  70.       MultiLine       =   -1  'True
  71.       ScrollBars      =   2  'Vertical
  72.       TabIndex        =   0
  73.       Top             =   630
  74.       Width           =   7260
  75.    End
  76. End
  77. Attribute VB_Name = "frmRegistry"
  78. Attribute VB_GlobalNameSpace = False
  79. Attribute VB_Creatable = False
  80. Attribute VB_PredeclaredId = True
  81. Attribute VB_Exposed = False
  82. Option Explicit
  83. Option Base 1
  84.  
  85. Private Const Iteration = 250
  86.  
  87. Dim IsLoaded         As Integer
  88.  
  89. Dim TimerStartOk     As Integer
  90. Dim TimerCloseOk     As Integer
  91.  
  92. Dim TimerHandle      As Integer
  93. Dim TimerValue       As Long
  94.  
  95. Private Sub cmdNP_Click(Index As Integer)
  96.  
  97.    Call sub_NextPrev(cmb_Function, Index)
  98.  
  99. End Sub
  100.  
  101.  
  102. Private Sub cmb_Function_Click()
  103.    
  104.    If (IsLoaded = False) Then Exit Sub
  105.    
  106.    Call cDisableFI(mdiT2W.Picture1)
  107.    
  108.    txt_Result = ""
  109.    
  110.    DoEvents
  111.    
  112.    Select Case cmb_Function.ListIndex
  113.       Case 0
  114.          Call TestRegistry
  115.       Case 1
  116.          Call TestRegistryExt
  117.       Case 2
  118.          Call TestGetAllSettings
  119.    End Select
  120.  
  121.    DoEvents
  122.    Call cEnableFI(mdiT2W.Picture1)
  123.    
  124. End Sub
  125.  
  126.  
  127. Private Sub Form_Activate()
  128.  
  129.    mdiT2W.Label2.Caption = cInsertBlocks(mdiT2W.Label2.Tag, "" & Iteration)
  130.  
  131. End Sub
  132.  
  133. Private Sub Form_Load()
  134.  
  135.    IsLoaded = False
  136.    
  137.    Show
  138.  
  139.    Call sub_Load_Combo(cmb_Function, T2WDirInst + "_registr.t2w")
  140.    
  141.    IsLoaded = True
  142.    
  143. End Sub
  144.  
  145.  
  146. Private Sub Command1_Click()
  147.    
  148.    Call cmb_Function_Click
  149.    
  150. End Sub
  151.  
  152. Private Sub TestRegistry()
  153.  
  154.    Dim intResult        As Integer
  155.    Dim strResult        As String
  156.    Dim strDisplay       As String
  157.    
  158.    Dim Section1         As String
  159.    Dim Section2         As String
  160.    
  161.    Dim i                As Integer
  162.    
  163.    Dim RKI              As tagREGISTRYKEYINFO
  164.    
  165.    strResult = ""
  166.    strDisplay = ""
  167.    
  168.    strDisplay = strDisplay & "HKEY_CURRENT_USER" & vbCrLf & vbCrLf
  169.    
  170.    Section1 = "under the fox"
  171.    Section2 = "software\The MCR Company\TIME TO WIN for VB 4.0"
  172.    
  173.    strDisplay = strDisplay & "Use section '" & Section1 & "'" & vbCrLf & vbCrLf
  174.    
  175.    strDisplay = strDisplay & "Setting default value to 'no key' is '" & cPutRegistry(Section1, "", "no key") & "'" & vbCrLf
  176.    strDisplay = strDisplay & "Setting value of key 'key1' to 'test key 1' is '" & cPutRegistry(Section1, "key1", "test key 1") & "'" & vbCrLf
  177.    strDisplay = strDisplay & "Setting value of key 'key2' to 'test key 2' is '" & cPutRegistry(Section1, "key2", "test key 2") & "'" & vbCrLf & vbCrLf
  178.    
  179.    strDisplay = strDisplay & "Getting default value is '" & cGetRegistry(Section1, "", "?") & "'" & vbCrLf
  180.    strDisplay = strDisplay & "Getting value of key 'key2' is '" & cGetRegistry(Section1, "key2", "?") & "'" & vbCrLf
  181.    strDisplay = strDisplay & "Getting value of key 'key1' is '" & cGetRegistry(Section1, "key1", "?") & "'" & vbCrLf & vbCrLf
  182.    
  183.    strDisplay = strDisplay & "Key information is '" & cRegistryKeyInfo(Section1, RKI) & "'" & vbCrLf
  184.    strDisplay = strDisplay & "   SubKeys = " & RKI.lSubKeys & vbCrLf
  185.    strDisplay = strDisplay & "   MaxSubKeyLen = " & RKI.lMaxSubKeyLen & vbCrLf
  186.    strDisplay = strDisplay & "   Values = " & RKI.lValues & vbCrLf
  187.    strDisplay = strDisplay & "   MaxValueNameLen = " & RKI.lMaxValueNameLen & vbCrLf
  188.    strDisplay = strDisplay & "   MaxValueLen = " & RKI.lMaxValueLen & vbCrLf
  189.    strDisplay = strDisplay & "   InfoInStr = " & RKI.sInfoInStr & vbCrLf & vbCrLf
  190.  
  191.    strDisplay = strDisplay & "Use section '" & Section2 & "'" & vbCrLf & vbCrLf
  192.    
  193.    strDisplay = strDisplay & "Setting default value to 'License information' is '" & cPutRegistry(Section2, "", "License information") & "'" & vbCrLf
  194.    strDisplay = strDisplay & "Setting value of key 'Name' to 'James' is '" & cPutRegistry(Section2, "Name", "James") & "'" & vbCrLf
  195.    strDisplay = strDisplay & "Setting value of key 'Id' to 'Donb' is '" & cPutRegistry(Section2, "Id", "Donb") & "'" & vbCrLf
  196.    strDisplay = strDisplay & "Setting value of key 'N░' to '007' is '" & cPutRegistry(Section2, "N░", "007") & "'" & vbCrLf & vbCrLf
  197.    
  198.    strDisplay = strDisplay & "Getting default value is '" & cGetRegistry(Section2, "", "?") & "'" & vbCrLf
  199.    strDisplay = strDisplay & "Getting value of key 'Name' is '" & cGetRegistry(Section2, "Name", "?") & "'" & vbCrLf
  200.    strDisplay = strDisplay & "Getting value of key 'Id' is '" & cGetRegistry(Section2, "Id", "?") & "'" & vbCrLf
  201.    strDisplay = strDisplay & "Getting value of key 'N░' is '" & cGetRegistry(Section2, "N░", "?") & "'" & vbCrLf & vbCrLf
  202.    
  203.    strDisplay = strDisplay & "Key information is '" & cRegistryKeyInfo(Section2, RKI) & "'" & vbCrLf
  204.    strDisplay = strDisplay & "   SubKeys = " & RKI.lSubKeys & vbCrLf
  205.    strDisplay = strDisplay & "   MaxSubKeyLen = " & RKI.lMaxSubKeyLen & vbCrLf
  206.    strDisplay = strDisplay & "   Values = " & RKI.lValues & vbCrLf
  207.    strDisplay = strDisplay & "   MaxValueNameLen = " & RKI.lMaxValueNameLen & vbCrLf
  208.    strDisplay = strDisplay & "   MaxValueLen = " & RKI.lMaxValueLen & vbCrLf
  209.    strDisplay = strDisplay & "   InfoInStr = " & RKI.sInfoInStr & vbCrLf & vbCrLf
  210.  
  211.    strDisplay = strDisplay & "Kill Section 'under the fox' is '" & cKillRegistry(Section1, "") & "'" & vbCrLf & vbCrLf
  212.    strDisplay = strDisplay & "Kill Section 'software\The MCR Company' is '" & cKillRegistry("software\The MCR Company", "") & "'" & vbCrLf & vbCrLf
  213.    strDisplay = strDisplay & "Kill Section 'software\The MCR Company\TIME TO WIN for VB 4.0' is '" & cKillRegistry("software\The MCR Company\TIME TO WIN for VB 4.0", "") & "'" & vbCrLf & vbCrLf
  214.    
  215.    txt_Result = strDisplay
  216.    
  217.    'time the function
  218.  
  219.    intResult = cPutRegistry(Section2, "Name", "James")
  220.  
  221.    TimerHandle = cTimerOpen()
  222.    TimerStartOk = cTimerStart(TimerHandle)
  223.    
  224.    For i = 1 To Iteration
  225.       strResult = cGetRegistry(Section2, "", "?1")
  226.    Next i
  227.    
  228.    mdiT2W.pnl_Timer = cTimerRead(TimerHandle)
  229.    
  230.    TimerCloseOk = cTimerClose(TimerHandle)
  231.    
  232.    intResult = cKillRegistry("software\The MCR Company", "")
  233.  
  234. End Sub
  235.  
  236. Private Sub TestRegistryExt()
  237.  
  238.    Dim intResult        As Integer
  239.    Dim strResult        As String
  240.    Dim strDisplay       As String
  241.    
  242.    Dim Section1         As String
  243.    Dim Section2         As String
  244.    
  245.    Dim i                As Integer
  246.    
  247.    strResult = ""
  248.    strDisplay = ""
  249.    
  250.    strDisplay = strDisplay & "HKEY_LOCAL_MACHINE" & vbCrLf & vbCrLf
  251.    
  252.    strDisplay = strDisplay & "   (" & cGetRegistryExt(RK_HKEY_LOCAL_MACHINE, "HARDWARE\DESCRIPTION\System\CentralProcessor\0", "Identifier", "?") & ")" & vbCrLf
  253.    strDisplay = strDisplay & "   (" & cGetRegistryExt(RK_HKEY_LOCAL_MACHINE, "HARDWARE\DESCRIPTION\System\CentralProcessor\0", "VendorIdentifier", "?") & ")" & vbCrLf & vbCrLf
  254.    
  255.    Section1 = "under the fox"
  256.    Section2 = "software\The MCR Company\TIME TO WIN for VB 4.0"
  257.    
  258.    strDisplay = strDisplay & "Use section '" & Section1 & "'" & vbCrLf & vbCrLf
  259.    
  260.    strDisplay = strDisplay & "Setting default value to 'no key' is '" & cPutRegistryExt(RK_HKEY_LOCAL_MACHINE, Section1, "", "no key") & "'" & vbCrLf
  261.    strDisplay = strDisplay & "Setting value of key 'key1' to 'test key 1' is '" & cPutRegistryExt(RK_HKEY_LOCAL_MACHINE, Section1, "key1", "test key 1") & "'" & vbCrLf
  262.    strDisplay = strDisplay & "Setting value of key 'key2' to 'test key 2' is '" & cPutRegistryExt(RK_HKEY_LOCAL_MACHINE, Section1, "key2", "test key 2") & "'" & vbCrLf & vbCrLf
  263.    
  264.    strDisplay = strDisplay & "Getting default value is '" & cGetRegistryExt(RK_HKEY_LOCAL_MACHINE, Section1, "", "?") & "'" & vbCrLf
  265.    strDisplay = strDisplay & "Getting value of key 'key2' is '" & cGetRegistryExt(RK_HKEY_LOCAL_MACHINE, Section1, "key2", "?") & "'" & vbCrLf
  266.    strDisplay = strDisplay & "Getting value of key 'key1' is '" & cGetRegistryExt(RK_HKEY_LOCAL_MACHINE, Section1, "key1", "?") & "'" & vbCrLf & vbCrLf
  267.    
  268.    strDisplay = strDisplay & "Use section '" & Section2 & "'" & vbCrLf & vbCrLf
  269.    
  270.    strDisplay = strDisplay & "Setting default value to 'License information' is '" & cPutRegistryExt(RK_HKEY_LOCAL_MACHINE, Section2, "", "License information") & "'" & vbCrLf
  271.    strDisplay = strDisplay & "Setting value of key 'Name' to 'James' is '" & cPutRegistryExt(RK_HKEY_LOCAL_MACHINE, Section2, "Name", "James") & "'" & vbCrLf
  272.    strDisplay = strDisplay & "Setting value of key 'Id' to 'Donb' is '" & cPutRegistryExt(RK_HKEY_LOCAL_MACHINE, Section2, "Id", "Donb") & "'" & vbCrLf
  273.    strDisplay = strDisplay & "Setting value of key 'N░' to '007' is '" & cPutRegistryExt(RK_HKEY_LOCAL_MACHINE, Section2, "N░", "007") & "'" & vbCrLf & vbCrLf
  274.    
  275.    strDisplay = strDisplay & "Getting default value is '" & cGetRegistryExt(RK_HKEY_LOCAL_MACHINE, Section2, "", "?") & "'" & vbCrLf
  276.    strDisplay = strDisplay & "Getting value of key 'Name' is '" & cGetRegistryExt(RK_HKEY_LOCAL_MACHINE, Section2, "Name", "?") & "'" & vbCrLf
  277.    strDisplay = strDisplay & "Getting value of key 'Id' is '" & cGetRegistryExt(RK_HKEY_LOCAL_MACHINE, Section2, "Id", "?") & "'" & vbCrLf
  278.    strDisplay = strDisplay & "Getting value of key 'N░' is '" & cGetRegistryExt(RK_HKEY_LOCAL_MACHINE, Section2, "N░", "?") & "'" & vbCrLf & vbCrLf
  279.    
  280.    strDisplay = strDisplay & "Kill Section 'under the fox' is '" & cKillRegistryExt(RK_HKEY_LOCAL_MACHINE, Section1, "") & "'" & vbCrLf & vbCrLf
  281.    strDisplay = strDisplay & "Kill Section 'software\The MCR Company' is '" & cKillRegistryExt(RK_HKEY_LOCAL_MACHINE, "software\The MCR Company", "") & "'" & vbCrLf & vbCrLf
  282.    strDisplay = strDisplay & "Kill Section 'software\The MCR Company\TIME TO WIN for VB 4.0' is '" & cKillRegistryExt(RK_HKEY_LOCAL_MACHINE, "software\The MCR Company\TIME TO WIN for VB 4.0", "") & "'" & vbCrLf & vbCrLf
  283.    
  284.    txt_Result = strDisplay
  285.    
  286.    'time the function
  287.  
  288.    intResult = cPutRegistryExt(RK_HKEY_LOCAL_MACHINE, Section2, "Name", "James")
  289.  
  290.    TimerHandle = cTimerOpen()
  291.    TimerStartOk = cTimerStart(TimerHandle)
  292.    
  293.    For i = 1 To Iteration
  294.       strResult = cGetRegistryExt(RK_HKEY_LOCAL_MACHINE, Section2, "", "?1")
  295.    Next i
  296.    
  297.    mdiT2W.pnl_Timer = cTimerRead(TimerHandle)
  298.    
  299.    TimerCloseOk = cTimerClose(TimerHandle)
  300.    
  301.    intResult = cKillRegistryExt(RK_HKEY_LOCAL_MACHINE, "software\The MCR Company", "")
  302.  
  303. End Sub
  304.  
  305. Private Sub TestGetAllSettings()
  306.  
  307.    Dim intResult        As Integer
  308.    Dim strResult        As String
  309.    Dim strDisplay       As String
  310.    
  311.    Dim Section1         As String
  312.    Dim Section2         As String
  313.    
  314.    Dim i                As Integer
  315.    
  316.    Dim RKI              As tagREGISTRYKEYINFO
  317.    
  318.    SaveSetting "MyApp", "TestGetAllSettings", "Product", "TIME TO WIN 32-Bit"
  319.    SaveSetting "MyApp", "TestGetAllSettings", "Top", 75
  320.    SaveSetting "MyApp", "TestGetAllSettings", "Left", 50
  321.    SaveSetting "MyApp", "TestGetAllSettings", "Version", cGetVersion()
  322.    SaveSetting "MyApp", "TestGetAllSettings", "IsRegistered", cIsRegistered()
  323.    
  324.    strResult = ""
  325.    strDisplay = ""
  326.    
  327.    Section1 = "Software\VB and VBA Program Settings\MyApp\TestGetAllSettings"
  328.    
  329.    strDisplay = strDisplay & "Section is " & vbCrLf
  330.    strDisplay = strDisplay & "   " & Section1 & vbCrLf & vbCrLf
  331.    
  332.    strDisplay = strDisplay & "Key information is '" & cRegistryKeyInfo(Section1, RKI) & "'" & vbCrLf
  333.    strDisplay = strDisplay & "   SubKeys = " & RKI.lSubKeys & vbCrLf
  334.    strDisplay = strDisplay & "   MaxSubKeyLen = " & RKI.lMaxSubKeyLen & vbCrLf
  335.    strDisplay = strDisplay & "   Values = " & RKI.lValues & vbCrLf
  336.    strDisplay = strDisplay & "   MaxValueNameLen = " & RKI.lMaxValueNameLen & vbCrLf
  337.    strDisplay = strDisplay & "   MaxValueLen = " & RKI.lMaxValueLen & vbCrLf
  338.    strDisplay = strDisplay & "   InfoInStr = " & RKI.sInfoInStr & vbCrLf & vbCrLf
  339.    
  340.    ReDim Strarray(1 To (RKI.lValues + 1), 1 To 2) As String
  341.    
  342.    strDisplay = strDisplay & "Number of values is " & cGetAllSettings(Strarray(), Section1) & vbCrLf & vbCrLf
  343.    
  344.    For i = 1 To RKI.lValues
  345.       strDisplay = strDisplay & "   " & Strarray(i, 1) & " = " & Strarray(i, 2) & vbCrLf
  346.    Next i
  347.    
  348.    txt_Result = strDisplay
  349.    
  350.    'time the function
  351.  
  352.    TimerHandle = cTimerOpen()
  353.    TimerStartOk = cTimerStart(TimerHandle)
  354.    
  355.    For i = 1 To Iteration
  356.       intResult = cGetAllSettings(Strarray(), Section1)
  357.    Next i
  358.    
  359.    mdiT2W.pnl_Timer = cTimerRead(TimerHandle)
  360.    
  361.    TimerCloseOk = cTimerClose(TimerHandle)
  362.    
  363.    intResult = cKillRegistry(Section1, "")
  364.  
  365. End Sub
  366.  
  367.