Public Const filnavn = "users.dat"
Public Const kodefil = "kodes.dat"
Public Const openfil = "open.dat"
Type tuser
login As String * 8
passord As String * 8
farmername As String * 30
email As String * 25
End Type
Type tuserkode
login As String * 8
kode As String * 10
End Type
Global kodelengde As Integer ' forandres i typen og i cgi-main
Global a As Integer
Global tom As String * 8
Global filpostnr As Integer
Global userkode As tuserkode
Global user As tuser
Sub CGI_main()
kodelengde = 10
tom = "$"
checkforopen
Dim kommando As String
Dim kode As String
Select Case CGI_QueryString
Case "login"
startlogin
Case "regi"
register
Case Else
If Not CGI_QueryString = "" Then
kommando = Left$(CGI_QueryStrin, 4)
kode = Right$(CGI_QueryString, kodelengde)
Select Case kode
Case "over"
overview (kode)
End Select
End If
End Select
Close #9
Kill openfil
End Sub
Public Function startlogin() ' Logge in "exe" delen
Dim login As String * 8, passord As String
login = GetCgiValue("loginname")
passord = GetCgiValue("passord")
Close #1
Open filnavn For Random As #1 Len = Len(user)
For a = 1 To (LOF(1) \ Len(user)) + 1
Get #1, a, user
If login = user.login Then
If passord = user.passord Then
userk = createuserkode(login) 'login er username
fillframeset (userk)
Exit Function
Else
SendHeader Error
Send " Feil passord
" ' fant ikke login-name
SendFooter
Exit Function
End If
End If
Next
SendHeader Error
Send " Feil med login
" ' fant ikke login-name
SendFooter
End Function
Public Function createuserkode(username As String)
Dim tempfilpostnr As Integer
Close #2
Open kodefil For Random As #2 Len = Len(userkode)
For a = 1 To ((LOF(2) \ Len(userkode))) + 1
Get #2, a, userkode
If userkode.login = username Then
userkode.kode = generateRnd(kodelengde)
Put #2, a, userkode
createuserkode = userkode.kode
Exit Function
End If
Next
userkode.login = username
userkode.kode = generateRnd(kodelengde)
tempfilpostnr = finnnyuserkode
Put #2, tempfilpostnr, userkode
createuserkode = userkode.kode
End Function
Public Function generateRnd(lengde As Integer) As String
Dim tempkode As String
Dim siffer As String
Randomize
For a = 1 To lengde
siffer = (Int((Rnd(1) * 36) + 1))
If siffer <= 10 Then
tempkode = tempkode & Chr(siffer + 47)
Else
tempkode = tempkode & Chr(siffer + 54)
End If
Next
generateRnd = tempkode
End Function
--------------------------Here comes the part that want to save my login.exe on HD instead of open the two files in frames --------
Public Function fillframeset(tempkode As String)
Send "status:200 OK"
Send "content-type: tekst/HTML" & vbCrLf
Send " The Farm "
Send ""
Send "<![CDATA[<body> <p> Do not support frames! </p>"
Send "</body>]]>"
X
End Function
---------------------------------------------------------------
If I put a message box at the spot marked with X, it shows
------------------------------------------------------------
Public Function filltop(kode As String)
Dim usernumber As Integer
usernumber = finnuser(kode) ' tar med koden og finner usernumber i userfil (filnavn) tilbake
Send "status:200 OK"
Send "content-type: tekst/HTML" & vbCrLf
Send " meny "
Send ""
Send ""
Send "" & user.farmername & "
"
Send ""
End Function
Public Function overview(kode As String)
filltop kode
End Function
Public Function fillmeny(kode As String) 'userkode
Send "status:200 OK"
Send "content-type: tekst/HTML" & vbCrLf
Send " meny "
Send ""
Send ""
Send "Overview
"
Send "Messages
"
Send "Cows
"
Send "Sheep
"
Send "Pigs
"
Send ""
Send ""
End Function
Public Function finnnyuserkode()
Dim a As Integer
For a = 1 To (LOF(2) \ Len(userkode))
Get #2, a, userkode
If userkode.kode = tom Then
finnnyuserkode = a
Exit Function
End If
Next
finnnyuserkode = a + 1
End Function
Public Function finnuser(kode As String) ' sammen med findusernumber
Dim tempusername As String
Close #2
Open kodefil For Random As #2 Len = Len(userkode)
For a = 1 To (LOF(2) \ Len(userkode))
Get #2, a, userkode
If userkode.kode = kode Then
tempusername = userkode.login
finnuser = findusernumber(tempusername)
Close #2
Exit Function
End If
Next
MsgBox ("Fant ikke userkode")
End Function
Public Function findusernumber(tempuser As String) ' sammen med finnuser
Dim usernumber As Integer
Close #1
Open filnavn For Random As #1 Len = Len(user)
For a = 1 To (LOF(1) \ Len(user))
Get #1, a, user
If user.login = tempuser Then
usernumber = a
End If
Next
findusernumber = usernumber
End Function
Public Function findnewuser()
Close #1
Open filnavn For Random As #1 Len = Len(user)
For a = 1 To (LOF(1) \ Len(user))
Get #1, a, user
If user.login = tomuser Then
findnewuser = a
Exit Function
End If
Next
findnewuser = a + 1
End Function
Public Function register()
Dim usernumber As Integer
usernumber = findnewuser
user.login = GetCgiValue("username")
user.passord = GetCgiValue("passord")
user.email = GetCgiValue("email")
user.farmername = GetCgiValue("farmername")
Put #1, usernumber, user
SendHeader ("registered")
Send " User " & user.login & " created with farmer-name " & user.farmername & "
"
Send " your e-mail is " & user.email & " but no info is sent there. We trust you.
"
SendFooter
Close #1
End Function
Public Function checkforopen()
If Not Dir(openfil) = "" Then
SendHeader ("Wait for other action")
Send " fil already open, try again
"
SendFooter
End
Else
Close #9
Open openfil For Random As #9 Len = 1
End If
End Function