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