;this is generic functions that do some stuff
;created april 2003
;- user profile

Global MainPath.s
Global UserName.s
Global Password.s
Global Awards.s
Global Status.s
Global MaxProgs.s
Global RDate.s
Global RYear.s
Global Email.s
Global MasterKey.s

Structure MyStruct
  Tittle.s
  Proc.s
  Vars.s
EndStructure
Global MyHelper.Mystruct
Procedure MyDebug(notes.s)
  M.s="Procedure = "+ MyHelper\Proc +Chr(10)+Chr(13)
  M.s=notes+Chr(10)+Chr(13)
  M=M+"Variables :"+Chr(10)+Chr(13)
  M=M+MyHelper\Vars
  MessageRequester(MyHelper\Tittle,M,0)
EndProcedure
Procedure.s GetName()
  name.s=Left(UserName,Len(UserName)-1)
  For x=Len(name) To 1 Step -1
    If Mid(name,x,1)="\"
      name=Right(name,Len(name)-x)
      x=1
    EndIf
  Next x
  ProcedureReturn name
EndProcedure

Procedure.s GetCurrentpath()
  hMod = GetModuleHandle_(0)
  tmp$ = Space(255)
  GetModuleFilename_(hMod,@tmp$,255)
  ProcedureReturn GetPathPart(tmp$)

EndProcedure
Procedure SetForground()
  If GetForegroundWindow_()<>WindowID()
    SetForegroundWindow_(WindowID())
  EndIf
EndProcedure
Procedure ConvertText(key.s,*buffer,size.l)
  keysize.l=Len(key)
  b.s=PeekS(*buffer,size)
  T.s=""
  y=1
  
   
  For x=1 To size
    ykey.s=Mid(key,y,1)
    y=y+1
    If y>keysize
      y=1
    EndIf
    xkey.s=Mid(b,x,1)
    
    T=T+Chr(Asc(xkey)!Asc( ykey  ))
    
  Next x  
  PokeS(*buffer,T,size)
EndProcedure
Procedure GetMasterKey()
  RandomSeed(1492)
  t.l=0
  MasterKey=""
  For n=1 To 128
    r.l=Random(254)+1
    t+1
    If r<1 Or r>255
      r=128
    EndIf
    If t=3
      MasterKey=MasterKey + Chr(r)
      t=0
    EndIf
  Next n  
EndProcedure
Procedure SaveProfile()
  T.s=Left(Password + "123456",6)
  T=T+Right("000" + Awards,3)
  T=T+Right("000" + Status,3)
  T=T+Right("000" + MaxProgs,3)
  T=T+Right("000" + RDate,3)
  T=T+Right("000" + RYear,3)
  ;note, Email must be the last item always
  T=T+Email
  *Buffer=AllocateMemory(101,Len(T),0)
  PokeS(*Buffer,T,Len(T))
  key.s=MasterKey

  converttext(key,*Buffer,Len(T))
  If FileSize(UserName+"profile.enc")>0
    DeleteFile(UserName+"profile.enc")
  EndIf

  If OpenFile(1,UserName+"profile.enc")
    WriteData(*Buffer,Len(T))
    CloseFile(1)
  Else
    MessageRequester("Profile Error","Unable to save profile",0)
  EndIf
  FreeMemory(101)
  Delay(20)
EndProcedure
Procedure.s LoadEncFile(F.s)
  filename.s=UserName+F
  T.s=""
  If ReadFile(1,filename)
    If Lof()>2
      
      size.l=Lof()
      
      *buffer=AllocateMemory(101,size,0)
      ReadData(*buffer,size)
      
      converttext(MasterKey,*Buffer,size)
      T=PeekS(*Buffer,size)
      
      FreeMemory(101)
    EndIf
    CloseFile(1)
    
  EndIf
  ProcedureReturn T
EndProcedure
Procedure SaveEncFile(F.s,T.s)
  filename.s=UserName+F
  *buffer=AllocateMemory(101,Len(T),0)
  PokeS(*buffer,T,Len(T))
  
  converttext(MasterKey,*buffer,Len(T))
  If FileSize(filename)>0
    DeleteFile(filename)
  EndIf
  If OpenFile(1,filename)
    WriteData(*Buffer,Len(T))
    CloseFile(1)
  EndIf
  
  
EndProcedure
Procedure LoadProfile()
  filename.s=UserName+"profile.enc"
  If ReadFile(1,filename)
    If Lof()>10
      size.l=Lof()
      key.s=""
      *Buffer=AllocateMemory(101,size,0)
      ReadData(*Buffer,size)
      
      
      key=MasterKey
      
      ConvertText(key,*Buffer,size)
      T.s=PeekS(*Buffer,size)
      Password=Left(T,6)
      T=Right(T,size-6)
      Awards=Left(T,3)
      T=Right(T,Len(T)-3)
      Status=Left(T,3)
      T=Right(T,Len(T)-3)
      MaxProgs=Left(T,3)
      T=Right(T,Len(T)-3)
      RDate=Left(T,3)
      T=Right(T,Len(T)-3)
      RYear=Left(T,3)
      T=Right(T,Len(T)-3)
      ;note, email must be the last thing read
      EMail=T
      FreeMemory(101)
      CloseFile(1)
    Else
      ;something wrong with the file
      CloseFile(1)
      Password="123456"
      Awards="000"
      Status="000"
      RDate="000"
      RYear="000"
      MaxProgs="000"
      email=""  
      SaveProfile()
    EndIf
  Else
    ;must be a new user
    Password="123456"
    Awards="000"
    Status="000"
    RDate="000"
    RYear="000"
    MaxProgs="000"
    email=""
    SaveProfile()
  EndIf  
EndProcedure 
; ExecutableFormat=Windows
; EOF