home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 3_2004-2005.ISO / Data / Zips / Invests1726183292004.psc / frmLogin.frm < prev    next >
Text File  |  2004-03-29  |  18KB  |  503 lines
  1. VERSION 5.00
  2. Object = "{67397AA1-7FB1-11D0-B148-00A0C922E820}#6.0#0"; "MSADODC.OCX"
  3. Begin VB.Form frmLogin 
  4.    BorderStyle     =   3  'Fixed Dialog
  5.    Caption         =   "Investment Log In"
  6.    ClientHeight    =   6825
  7.    ClientLeft      =   765
  8.    ClientTop       =   2175
  9.    ClientWidth     =   9495
  10.    Icon            =   "frmLogin.frx":0000
  11.    LinkTopic       =   "Form1"
  12.    MaxButton       =   0   'False
  13.    MinButton       =   0   'False
  14.    ScaleHeight     =   4032.435
  15.    ScaleMode       =   0  'User
  16.    ScaleWidth      =   8915.291
  17.    ShowInTaskbar   =   0   'False
  18.    Begin VB.PictureBox Picture1 
  19.       BackColor       =   &H0080FFFF&
  20.       BorderStyle     =   0  'None
  21.       Height          =   555
  22.       Left            =   6435
  23.       Picture         =   "frmLogin.frx":0442
  24.       ScaleHeight     =   555
  25.       ScaleWidth      =   555
  26.       TabIndex        =   13
  27.       Top             =   2160
  28.       Width           =   555
  29.    End
  30.    Begin VB.TextBox txtRndm 
  31.       DataField       =   "RandomStr"
  32.       DataSource      =   "Adodc1"
  33.       Height          =   285
  34.       Left            =   180
  35.       TabIndex        =   12
  36.       Top             =   6480
  37.       Visible         =   0   'False
  38.       Width           =   1320
  39.    End
  40.    Begin MSAdodcLib.Adodc Adodc1 
  41.       Height          =   375
  42.       Left            =   3060
  43.       Top             =   6390
  44.       Visible         =   0   'False
  45.       Width           =   2535
  46.       _ExtentX        =   4471
  47.       _ExtentY        =   661
  48.       ConnectMode     =   0
  49.       CursorLocation  =   3
  50.       IsolationLevel  =   -1
  51.       ConnectionTimeout=   15
  52.       CommandTimeout  =   30
  53.       CursorType      =   3
  54.       LockType        =   3
  55.       CommandType     =   8
  56.       CursorOptions   =   0
  57.       CacheSize       =   50
  58.       MaxRecords      =   0
  59.       BOFAction       =   0
  60.       EOFAction       =   0
  61.       ConnectStringType=   1
  62.       Appearance      =   1
  63.       BackColor       =   -2147483643
  64.       ForeColor       =   -2147483640
  65.       Orientation     =   0
  66.       Enabled         =   -1
  67.       Connect         =   ""
  68.       OLEDBString     =   ""
  69.       OLEDBFile       =   ""
  70.       DataSourceName  =   ""
  71.       OtherAttributes =   ""
  72.       UserName        =   ""
  73.       Password        =   ""
  74.       RecordSource    =   ""
  75.       Caption         =   "Adodc1"
  76.       BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
  77.          Name            =   "MS Sans Serif"
  78.          Size            =   8.25
  79.          Charset         =   0
  80.          Weight          =   400
  81.          Underline       =   0   'False
  82.          Italic          =   0   'False
  83.          Strikethrough   =   0   'False
  84.       EndProperty
  85.       _Version        =   393216
  86.    End
  87.    Begin VB.CommandButton cmdChangePassword 
  88.       Caption         =   "Change Password"
  89.       Height          =   465
  90.       Left            =   5535
  91.       TabIndex        =   6
  92.       Top             =   5220
  93.       Width           =   2490
  94.    End
  95.    Begin VB.CommandButton cmdChangeOwnerName 
  96.       Caption         =   "Change Owner Name"
  97.       Height          =   465
  98.       Left            =   5535
  99.       TabIndex        =   5
  100.       Top             =   4590
  101.       Width           =   2490
  102.    End
  103.    Begin VB.TextBox txtConfirmPassword 
  104.       BackColor       =   &H00E6F2FF&
  105.       Height          =   330
  106.       IMEMode         =   3  'DISABLE
  107.       Left            =   5535
  108.       MaxLength       =   10
  109.       PasswordChar    =   "*"
  110.       TabIndex        =   2
  111.       Top             =   3420
  112.       Width           =   2310
  113.    End
  114.    Begin VB.TextBox txtOwner 
  115.       BackColor       =   &H00E6F2FF&
  116.       Height          =   345
  117.       Left            =   5535
  118.       MaxLength       =   20
  119.       TabIndex        =   0
  120.       Top             =   1665
  121.       Width           =   2325
  122.    End
  123.    Begin VB.CommandButton cmdOK 
  124.       BackColor       =   &H00ADC4AA&
  125.       Caption         =   "OK"
  126.       Default         =   -1  'True
  127.       Height          =   525
  128.       Left            =   5040
  129.       Style           =   1  'Graphical
  130.       TabIndex        =   3
  131.       Top             =   3870
  132.       Width           =   1500
  133.    End
  134.    Begin VB.CommandButton cmdCancel 
  135.       BackColor       =   &H00243DE8&
  136.       Cancel          =   -1  'True
  137.       Caption         =   "Cancel   (Terminate Program without saving changes)"
  138.       Height          =   525
  139.       Left            =   6660
  140.       MaskColor       =   &H00808080&
  141.       Style           =   1  'Graphical
  142.       TabIndex        =   4
  143.       Top             =   3870
  144.       Width           =   2265
  145.    End
  146.    Begin VB.TextBox txtPassword 
  147.       BackColor       =   &H00E6F2FF&
  148.       Height          =   345
  149.       IMEMode         =   3  'DISABLE
  150.       Left            =   5535
  151.       MaxLength       =   10
  152.       PasswordChar    =   "*"
  153.       TabIndex        =   1
  154.       Top             =   2880
  155.       Width           =   2325
  156.    End
  157.    Begin VB.Label lblChanges 
  158.       Caption         =   $"frmLogin.frx":0884
  159.       BeginProperty Font 
  160.          Name            =   "MS Sans Serif"
  161.          Size            =   9.75
  162.          Charset         =   0
  163.          Weight          =   400
  164.          Underline       =   0   'False
  165.          Italic          =   0   'False
  166.          Strikethrough   =   0   'False
  167.       EndProperty
  168.       Height          =   1725
  169.       Left            =   270
  170.       TabIndex        =   11
  171.       Top             =   4455
  172.       Width           =   5100
  173.    End
  174.    Begin VB.Label lblPassword 
  175.       Caption         =   $"frmLogin.frx":0A46
  176.       BeginProperty Font 
  177.          Name            =   "MS Sans Serif"
  178.          Size            =   9.75
  179.          Charset         =   0
  180.          Weight          =   400
  181.          Underline       =   0   'False
  182.          Italic          =   0   'False
  183.          Strikethrough   =   0   'False
  184.       EndProperty
  185.       Height          =   780
  186.       Left            =   540
  187.       TabIndex        =   10
  188.       Top             =   2565
  189.       Width           =   4920
  190.    End
  191.    Begin VB.Label lblOwner 
  192.       Caption         =   "Owner Name:  (Use up to 20 letters and/or digits) "
  193.       BeginProperty Font 
  194.          Name            =   "MS Sans Serif"
  195.          Size            =   9.75
  196.          Charset         =   0
  197.          Weight          =   400
  198.          Underline       =   0   'False
  199.          Italic          =   0   'False
  200.          Strikethrough   =   0   'False
  201.       EndProperty
  202.       Height          =   285
  203.       Left            =   900
  204.       TabIndex        =   9
  205.       Top             =   1710
  206.       Width           =   4560
  207.    End
  208.    Begin VB.Label lblConfirmPassword 
  209.       Caption         =   "Confirm Password:"
  210.       BeginProperty Font 
  211.          Name            =   "MS Sans Serif"
  212.          Size            =   9.75
  213.          Charset         =   0
  214.          Weight          =   400
  215.          Underline       =   0   'False
  216.          Italic          =   0   'False
  217.          Strikethrough   =   0   'False
  218.       EndProperty
  219.       Height          =   240
  220.       Left            =   3735
  221.       TabIndex        =   8
  222.       Top             =   3465
  223.       Width           =   1680
  224.    End
  225.    Begin VB.Label lblNewOwner 
  226.       BackColor       =   &H00C0FFFF&
  227.       Caption         =   $"frmLogin.frx":0AE4
  228.       BeginProperty Font 
  229.          Name            =   "MS Sans Serif"
  230.          Size            =   9.75
  231.          Charset         =   0
  232.          Weight          =   700
  233.          Underline       =   0   'False
  234.          Italic          =   0   'False
  235.          Strikethrough   =   0   'False
  236.       EndProperty
  237.       ForeColor       =   &H000000C0&
  238.       Height          =   1365
  239.       Left            =   270
  240.       TabIndex        =   7
  241.       Top             =   135
  242.       Visible         =   0   'False
  243.       Width           =   8520
  244.       WordWrap        =   -1  'True
  245.    End
  246. End
  247. Attribute VB_Name = "frmLogin"
  248. Attribute VB_GlobalNameSpace = False
  249. Attribute VB_Creatable = False
  250. Attribute VB_PredeclaredId = True
  251. Attribute VB_Exposed = False
  252. '---Login is case sensitive:
  253. '---Owner Name and Password are stored in 5th record of Random table
  254. '---Owner Name length is Asc(1st char)-36
  255. '---Owner Name is stored beginning in 2nd char and is decoded by
  256. '---shifting up 2 ascii characters.
  257. '---Password length is at 22nd char and begins at 23rd.
  258. '---Decoding same as Owner Name
  259. '---1st character of 5th record changed from d when
  260. '---owner name and password are intiialized
  261. Option Explicit
  262. Public intLenOwner As Integer  '---length of owner name
  263. Public intLenPassword As Integer  '---length of password
  264. Public strBuildName As String   '---to build decoded owner name
  265. Public strBuildPassword           '---to build decoded password
  266. Public strBuildCoded As String   '---to build coded owner name and password
  267. Public PasswordAccepted As Boolean  '---flag true if entered password
  268.                                     '---matched saved password
  269. Public PasswordLegit As Boolean    '---flag true if password & confirm password
  270.                                    '---match & formatted ok
  271. Dim I As Integer
  272.  
  273. Private Sub Form_Load()
  274.    '---get Random records for Login use
  275.    Adodc1.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & _
  276.    App.Path & "\Invests.mdb; Persist Security Info=False; Jet OLEDB:Database Password=fred"
  277.    Adodc1.CursorLocation = adUseClient
  278.    Adodc1.CommandType = adCmdText
  279.    Adodc1.CursorType = adOpenStatic '---this may need to be adOpenStatic
  280.    Adodc1.LockType = adLockOptimistic '---Guarantee that record being edited can be saved
  281.    Adodc1.RecordSource = "Select * From Random"
  282.    Adodc1.Refresh
  283.    Adodc1.Recordset.MoveFirst
  284.    Adodc1.Recordset.MoveNext
  285.    Adodc1.Recordset.MoveNext
  286.    Adodc1.Recordset.MoveNext
  287.    Adodc1.Recordset.MoveNext   '---now at 5th record
  288.    strBuildCoded = txtRndm.Text '---move codes to modifiable string
  289.    If Mid$(strBuildCoded, 1, 1) = "d" Then   '---if Owner Name & password not initialized
  290.       lblNewOwner.Visible = True
  291.       lblChanges.Visible = False
  292.       cmdChangeOwnerName.Enabled = False
  293.       cmdChangePassword.Enabled = False
  294.    Else
  295.       lblNewOwner.Visible = False
  296.       lblChanges.Visible = True
  297.       cmdChangeOwnerName.Enabled = True
  298.       txtOwner.Enabled = False  '---cannot change owner name w/o click change
  299.       cmdChangePassword.Enabled = True
  300.       lblConfirmPassword.Visible = False
  301.       txtConfirmPassword.Visible = False
  302.       If Mid$(strBuildCoded, 1, 1) <> "d" Then   '---if OwnerName inititalized
  303.          intLenOwner = Asc(Mid$(strBuildCoded, 1, 1)) - 36 '---get length of OwnerName
  304.          strBuildName = ""   '---decode and
  305.          For I = 1 To intLenOwner   '---fill in OwnerName
  306.             strBuildName = strBuildName + Chr$(Asc(Mid$(txtRndm.Text, I + 1, 1)) + 2)
  307.          Next I
  308.          OwnerName = strBuildName   '--- and set Owner Name for Program to use
  309.          txtOwner.Text = OwnerName
  310.       End If
  311.    End If
  312. End Sub
  313.  
  314. Private Sub cmdCancel_Click()
  315.    MsgBox ("You must complete Log In to access the program.  The program will now terminate.")
  316.    End
  317. End Sub
  318.  
  319. Private Sub cmdOK_Click()
  320.    strBuildCoded = txtRndm.Text '---move codes to new copy of modifiable string
  321.    If cmdOK.Caption = "Save New Owner Name" Then
  322.       If txtOwner = "" Then
  323.          MsgBox "Owner Name must be established."
  324.          txtOwner.SetFocus
  325.          Exit Sub    '---exit without saving OwnerName
  326.       Else
  327.          Call CodeOwnerName
  328.          Call SaveNameAndPassword
  329.          Exit Sub
  330.       End If
  331.    End If
  332.    If cmdOK.Caption = "Save New Password" Then
  333.       Call EstablishPassword(PasswordLegit)
  334.       If PasswordLegit = False Then
  335.          Exit Sub
  336.       End If
  337.    End If
  338.    '---now get the OwnerName for the first time
  339.    If Mid$(strBuildCoded, 1, 1) = "d" Then   '---if OwnerName & password not inititalized
  340.       If txtOwner = "" Then
  341.          MsgBox "Owner Name must be established."
  342.          txtOwner.SetFocus
  343.          Exit Sub    '---exit without saving OwnerName
  344.       Else
  345.          Call CodeOwnerName
  346.       End If
  347.       '---now get the password for the first time
  348.       Call EstablishPassword(PasswordLegit)
  349.       If PasswordLegit = False Then
  350.          Exit Sub
  351.       Else
  352.          Call SaveNameAndPassword
  353.       End If
  354.    Else
  355.       '---code follows for OwnerName and password previously initialized
  356.       Call DecodeOwnerName
  357.       '---now decode and compare the saved password
  358.       Call CheckPassword(PasswordAccepted)
  359.       If PasswordAccepted = False Then
  360.          Exit Sub
  361.       Else
  362.          Me.Hide    '---log in was succcessful
  363.          frmMain.Show  '---proceed with program
  364.       End If
  365.    End If
  366. End Sub
  367.  
  368. Private Sub cmdChangeOwnerName_Click()
  369.    cmdOK.Caption = "Save New Owner Name"
  370.    Call CheckPassword(PasswordAccepted)
  371.    If PasswordAccepted = False Then
  372.       cmdOK.Caption = "Ok"
  373.       Exit Sub
  374.    Else
  375.       txtOwner.Enabled = True
  376.       txtOwner = ""
  377.       txtOwner.SetFocus
  378.    End If
  379. End Sub
  380. Private Sub cmdChangePassword_Click()
  381.    cmdOK.Caption = "Save New Password"
  382.    Call CheckPassword(PasswordAccepted)
  383.    If PasswordAccepted = False Then
  384.       MsgBox "The Password entered was not valid.  The Log In will now start over."
  385.       cmdOK.Caption = "Ok"
  386.       Exit Sub
  387.    Else
  388.       txtPassword.Enabled = True
  389.       txtPassword = ""
  390.       txtConfirmPassword.Visible = True
  391.       txtConfirmPassword = ""
  392.       txtPassword.SetFocus
  393.    End If
  394. End Sub
  395.  
  396. Private Sub CodeOwnerName()
  397.    Mid$(strBuildCoded, 1, 1) = Chr$(Len(txtOwner) + 36) '---set coded length of OwnerName
  398.    For I = 1 To Len(txtOwner)   '---fill in coded OwnerName
  399.       Mid$(strBuildCoded, I + 1, 1) = Chr$(Asc(Mid$(txtOwner, I, 1)) - 2)
  400.    Next I
  401.    OwnerName = txtOwner '--- and set Owner Name for Program to use
  402. End Sub
  403.  
  404. Private Sub EstablishPassword(Ok As Boolean)   'get a newpassword &
  405.                                          '---confirm, save it
  406.    Ok = True
  407.    If Len(txtPassword) < 4 Then
  408.       MsgBox "A password of at least 4 characters must be established.  The Log In will now start over."
  409.       txtOwner = ""
  410.       txtPassword = ""
  411.       Ok = False
  412.       Exit Sub  '---exit without saving OwnerName or password
  413.    Else
  414.       intLenPassword = Len(txtPassword)
  415.       Mid$(strBuildCoded, 22, 1) = Chr$(intLenPassword + 36) '---put the coded length in strBuildCoded
  416.       For I = 1 To intLenPassword  '---put the coded password into strBuildCoded
  417.          Mid$(strBuildCoded, I + 22, 1) = Chr$(Asc(Mid$(txtPassword, I, 1)) - 2)
  418.       Next I
  419.    End If
  420.    If txtConfirmPassword = "" Or txtConfirmPassword <> txtPassword Then
  421.       MsgBox "The Password did not match the Confirm Password.  The Log In will now start over."
  422.       txtOwner = ""
  423.       txtPassword = ""
  424.       txtConfirmPassword = ""
  425.       txtOwner.SetFocus
  426.       Ok = False
  427.       Exit Sub   '---exit without saving Owner Name & password
  428.    Else
  429.       Call SaveNameAndPassword
  430.    End If
  431. End Sub
  432.  
  433. Private Sub SaveNameAndPassword()
  434.    txtRndm.Text = strBuildCoded   '---save the new coded OwnerName & password
  435.    Adodc1.Recordset.MoveNext
  436.    Me.Hide   '---the log in was successful
  437.    frmMain.Show   '---proceed with program
  438. End Sub
  439.  
  440. Private Sub DecodeOwnerName()
  441.    intLenOwner = Asc(Mid$(strBuildCoded, 1, 1)) - 36
  442.    OwnerName = "" '---build the decoded owner name
  443.    For I = 1 To intLenOwner
  444.       OwnerName = OwnerName + Chr$(Asc(Mid$(strBuildCoded, I + 1, 1)) + 2)
  445.    Next I
  446.    txtOwner.Text = OwnerName
  447. End Sub
  448.  
  449. Private Sub CheckPassword(Passed As Boolean)  '---compare entered password to
  450.                                               '---saved password
  451.    Passed = True
  452.    intLenPassword = Asc(Mid$(strBuildCoded, 22, 1)) - 36
  453.    strBuildPassword = ""
  454.    For I = 1 To intLenPassword
  455.       strBuildPassword = strBuildPassword + Chr$(Asc(Mid$(strBuildCoded, I + 22, 1)) + 2)
  456.    Next I
  457.    If txtPassword = "" Or txtPassword <> strBuildPassword Then
  458.       MsgBox "The Password entered was not valid.  The Log In will now start over."
  459.       txtPassword = ""
  460.       txtPassword.SetFocus
  461.       Passed = False
  462.    End If
  463. End Sub
  464.  
  465. Private Sub txtPassword_KeyPress(KeyAscii As Integer)
  466.    '---allow txtPassword to take only Ascii CHR$(32) to Chr$(122)
  467.    '---else beep and leave cursor where it is.
  468.    Select Case KeyAscii
  469.       Case 8   '---backspace key
  470.       Case 32 To 122  '---Ascii CHR$(32) to Chr$(122)
  471.       Case Else:
  472.          Beep
  473.          KeyAscii = 0
  474.    End Select
  475. End Sub
  476.  
  477. Private Sub txtConfirmPassword_KeyPress(KeyAscii As Integer)
  478.    '---allow txtConfirmPassword to take only Ascii CHR$(32) to Chr$(122)
  479.    '---else beep and leave cursor where it is.
  480.    Select Case KeyAscii
  481.       Case 8   '---backspace key
  482.       Case 32 To 122  '---Ascii CHR$(32) to Chr$(122)
  483.       Case Else:
  484.          Beep
  485.          KeyAscii = 0
  486.    End Select
  487. End Sub
  488.  
  489. Private Sub txtOwner_KeyPress(KeyAscii As Integer)
  490.    '---allow txtOwner to take only Ascii CHR$(32), A-Z, a-z, 0-9
  491.    '---else beep and leave cursor where it is.
  492.    Select Case KeyAscii
  493.       Case 8   '---backspace key
  494.       Case 32   '---space
  495.       Case 48 To 57  '---0 to 9
  496.       Case 65 To 90   '---A to Z
  497.       Case 97 To 122   '---a to z
  498.       Case Else:
  499.          Beep
  500.          KeyAscii = 0
  501.    End Select
  502. End Sub
  503.