;
; X-Mailing Form Process
;
; FORM POST to TEXT/HTML PAGE
;
; by BadDolls Production
;
; Be FREE to do what you want
; with this source...

WBStartup
NoCli

WbToScreen 0
ShowScreen 0

;-------------------------------------
;  / Using Default Font from Workbench
;-------------------------------------

FontHeight=8
If OpenFontPrefs
  Font$=DefaultFontName(1)+".font"
  FontHeight=DefaultFontHeight(1)
  CloseFontPrefs
  If Exists("Fonts:"+Font$)
    LoadFont 0,Font$,FontHeight
  EndIf
EndIf

;-------------------------------------
;  / Def Some Var
;-------------------------------------

MaxLen LSNom$=108

*s.Screen=Peek.l(Addr Screen(0))
SWidth=*s\Width
SHeight=*s\Height

W_Win=-(SWidth<500)*(SWidth-50)-(SWidth>500)*500
H_Win=220

DEFTYPE.b char
DEFTYPE.l mem,Lenght,req

NEWTYPE.value
  num.w
  s.s
End NEWTYPE

Dim Field$(100)
Dim Contenu$(100)
Dim List Liste.value(100)

While AddItem(Liste())
  Liste()\num=a,""
  a+1
Wend

;-------------------------------------
;  / Open Locale Catalog
;-------------------------------------

Dim LocText$(50)

*XCat=OpenCatalogA_(0,"XMFProcess.catalog",0)
If *XCat
  Gosub Localise
  CloseCatalog_(*XCat)
Else
  Gosub Datalise
EndIf

;-------------------------------------
;  / Def Some Statements & Functions
;-------------------------------------
Statement Find{code1,code2}
  SHARED mem,i
  While char<>code1 AND char<>code2
    char=Peek.b (mem+i)
    i+1
  Wend
End Statement

;------------

Function.s Read_Until{code1,code2,space_code}
  SHARED mem,i,Flag_Return
  Flag_Return=True
  While char<>code1 AND char<>code2
    char=Peek.b(mem+i)
    i+1
    If (char>31 AND char<128) OR (char>159 AND char<256)
      If char=space_code Then char=32
      If char=37
        char1.w = Peek.w(mem+i)
        char2.w=Val("$"+Mki$(char1))
        i+2
        If char2=$0A
          Flag_Return=False
          Function Return Text$
        Else
          If (char2>31 AND char2<128) OR (char2>159 AND char2<256)
            Text$+Chr$(char2)
          EndIf
        EndIf
      EndIf
      If char<>code1 AND char<>code2 AND char<>37
        Text$+Chr$(char)
      EndIf
    EndIf
  Wend
  Function Return Text$
End Function

;------------

;-------------------------------------
;  / Encore Quelques Variables...
;-------------------------------------
WinTitle$="XFMProcess V1.0"
ScrTitle$=WinTitle$+LocText$(0)

GTGZZPosition On

GTButton  0,0,5,4,84,13,LocText$(1),$10
GTButton   0,1,90,4,84,13,LocText$(2),$10
GTButton   0,2,175,4,84,13,LocText$(3),$10
GTText     0,3,3,19,W_Win-16,13,"",$0,""
GTText     0,4,3,189,W_Win-16,13,"",$0,""
GTListView 0,5,3,35,W_Win-16,147,"",1,Liste()

DefaultIDCMP $024C077E
Window 0,(SWidth-W_Win)/2,(SHeight-H_Win)/2,W_Win,H_Win,$200140E,"",1,2
WTitle WinTitle$,ScrTitle$
*rp.RastPort   =RastPort(0)
LenghtOneLetter=TextLength_(*rp,"W",1)
Cesure         =Int((InnerWidth-20)/LenghtOneLetter)

AttachGTList 0,0

GTMenuTitle 0,0,LocText$(4)           ;"Projet"
GTMenuItem  0,0,0,0,LocText$(5),"l"   ;"Charger"
GTMenuItem  0,0,0,1,LocText$(6)       ;"Sauver Txt"
GTMenuItem  0,0,0,2,LocText$(7)       ;"Sauver Html"
GTMenuItem  0,0,0,3
GTMenuItem  0,0,0,4,LocText$(8)       ;"A propos"
GTMenuItem  0,0,0,5,LocText$(9),"q"   ;"Quitter"
CreateMenuStrip 0

Use Window 0
CatchDosErrs
GTSetMenu 0


GTSetString 0,4,LocText$(10)

Repeat
  ev.l=WaitEvent
  If ev=$40 AND commence
    sg.l=GadgetHit
    Select sg
    Case 0
      Gosub _Aff_Orig
    Case 1
      Gosub _Aff_Txt
    Case 2
      Gosub _Aff_Html
    End Select
  EndIf
  If ev=$100
    If MenuHit=0
      si.l=ItemHit
      Select si
      Case 0
        Gosub _Read
      Case 1
        If commence
          Gosub _SaveTXT
        EndIf
      Case 2
        If commence
          Gosub _SaveHTML
        EndIf
      Case 4
        About$=LocText$(34)+Chr$(10)
        About$+LocText$(35)+Chr$(10)
        About$+LocText$(36)+Chr$(10)
        About$+LocText$(37)+Chr$(10)
        About$+LocText$(38)+Chr$(10)
        About$+LocText$(39)+Chr$(10)
        About$+LocText$(40)+Chr$(10)
        About$+LocText$(41)+Chr$(10)
        About$+LocText$(42)+Chr$(10)
        Req=RTEZRequest(LocText$(8),About$,LocText$(21),2,0,4)
      Case 5
        Gosub Quit
      End Select
    EndIf
  EndIf
  If ev=$200
    Gosub Quit
  EndIf
Until Quit
;
If mem
  ok=FreeMem_(mem,Lenght)
EndIf
DetachGTList 0
CloseWindow 0
Free GTList 0
Forbid_
End

.Quit
Req=RTEZRequest(LocText$(11),LocText$(12),LocText$(13),2,0,4)
If Req
  Quit=True
End If
Return

;______________
;--------------

._Read

  File_$=RTEZLoadFile("Loading an E-Mail",LSNom$)
  Lenght=Exists(File_$) AND File_$<>""
  If ReadFile(0,File_$)
    FileInput 0
    For o=0 To 3
      Test$=Edit$(256)
      If UCase$(Left$(Test$,4))="FROM"
        Contenu$(0)=UnRight$(Test$,5)
      EndIf
      If UCase$(Left$(Test$,4))="DATE"
        Contenu$(1)=UnRight$(Test$,5)
      EndIf
    Next
    If Contenu$(0)="" OR Contenu$(1)=""
      Lenght=False
    EndIf
    CloseFile 0
  EndIf

  If Lenght
    If mem
      ok=FreeMem_(mem,Lenght)
    EndIf
    mem=AllocMem_(Lenght,65536)
    If mem
      If BLoad(File_$,mem)
        i=0 : f=0
        GTSetString 0,3,File_$
        GTSetString 0,4,LocText$(15)
        ;
        ;  Email
        ;
        Field$(0)="From"
        Field$(1)="Date"
        For o=0 To 3
          Find{10,256} ; Research End of Line
        Next
        ;
        Find{10,256} ; Clear line
        Field$(2)="-----"
        Contenu$(2)="------------------"
        ;
        ; First Field
        ;
        f=3
        Field$(f)=Read_Until{61,256,43}

        While Field$(f)<>"VALID"
          Flag_Return=False
          While Flag_Return<>True
            Contenu$(f)=Read_Until{38,256,43}
            f+1
            Field$(f)=SPACE$(Len(Field$(f-1)))
          Wend
          Field$(f)=UCase$(Read_Until{61,256,43})
        Wend
        GTSetString 0,4,LocText$(16)
        f-1
        commence=1 : TxtProcess=False
        Gosub _Aff_Txt
      Else
        Req=RTEZRequest(LocText$(17),LocText$(18)+File_$,LocText$(21))
      EndIf
    Else
      Req=RTEZRequest(LocText$(17),LocText$(19),LocText$(21))
    EndIf
  Else
    Req=RTEZRequest(LocText$(17),LocText$(20),LocText$(21))
  EndIf
Return

._Aff_Txt
  a=0
  PosX=10 : PosY=40

  If TxtProcess=False
    LongField=0
    For j=0 To f
      LongField=Max(LongField,Len(Field$(j))+1)
    Next
    For j=0 To f
      Field$(j)=Field$(j)+SPACE$(LongField-Len(Field$(j)))+": "
    Next
    TxtProcess=True
  EndIf

  GTChangeList 0,5
  For j=0 To 99
    Liste(j)\num=j,""
  Next
  For j=0 To f
    Contenu$=Contenu$(j)
    ContenuLeft$ =Left$(Contenu$,Cesure-LongField-1)
    Contenu$=UnRight$(Contenu$,Cesure-LongField-1)
    Liste(a)\num=a,Field$(j)+ContenuLeft$
    a+1
    While Len(Contenu$)>(Cesure-LongField)
      ContenuLeft$ =Left$(Contenu$,Cesure-LongField-1)
      Contenu$=UnRight$(Contenu$,Cesure-LongField-1)
      Liste(a)\num=a,SPACE$(Len(Field$(j)))+": "+ContenuLeft$
      a+1
    Wend
    If Len(Contenu$)>=1
      Liste(a)\num=a,SPACE$(LongField)+": "+Contenu$
      a+1
    EndIf
  Next
  GTChangeList 0,5,Liste()
Return

._Aff_Orig
  PosX=10 : PosY=40
  a=0 : i=0

  GTChangeList 0,5
  For j=0 To 99
    Liste(j)\num=j,""
  Next
  Repeat
    char=Peek.b(mem+i)
    i+1 : b+1
    If b>=Cesure OR char=10
      Liste(a)\num=a,Text$
      a+1 : b=0 : Text$=""
    EndIf
    If char<>10
      Text$+Chr$(char)
    EndIf
  Until i>=Lenght
  GTChangeList 0,5,Liste()
Return

._Aff_Html
Return

._SaveTXT
  LSNom$=File_$+".txt"
  File_$=RTEZLoadFile(LocText$(22),LSNom$)
  Req=True
  If Exists(File_$) AND File_$<>""
    Req=RTEZRequest(LocText$(23),File_$+LocText$(24),LocText$(13),2,0,4)
  EndIf
  If Req
    If WriteFile(0,File_$)
      FileOutput 0
      For a=0 To f
        NPrint Field$(a)+Contenu$(a)
      Next
      CloseFile 0
    EndIf
    ;If Exists(File_$) AND File_$<>""
    ;  SucExe=Execute_("Run "+"Dh0:C/More"+" "+File_$,0,0)
    ;EndIf
    GTSetString 0,4,LocText$(16)
  EndIf
Return

._SaveHTML

Return

;--------------
.Localise
For i=0 To 42
  LocText$(i)=PeekTo$(GetCatalogStr_(*XCat,i,0),0)
Next
Return
;--------------
.Datalise
Restore LocText
For i=0 To 42
  Read LocText$(i)
Next
Return
;--------------

LocText
Data$ "by BadDolls Production (1997)"           ; "par BadDolls Production (1997)"
Data$ "E-Mail"                                  ; "E-Mail"
Data$ "Text"                                    ; "Texte"
Data$ "Html"                                    ; "Html"
Data$ "Project"                                 ; "Projet"
Data$ "Load File"                               ; "Lire Fichier"
Data$ "Save Txt"                                ; "Sauver Txt"
Data$ "Save Html"                               ; "Sauver Html"
Data$ "About"                                   ; "A propos"
Data$ "Quit"                                    ; "Quitter"
Data$ "Ready for working..."                    ; "Je vous attends"
Data$ "Request"                                 ; "Requete"
Data$ "Do U really want to quit XMFProcess ???" ; "Voulez-vous vraiment quitter XMFProcess ???"
Data$ "Yes|No !"                                ; "Oui|Nooon !!!"
Data$ "Loading an E-Mail"                       ; "Chargement d'un E-Mail"
Data$ "Working..."                              ; "Je travaille..."
Data$ "Status : Ok"                             ; "Statut : Ok"
Data$ "Error !!!"                               ; "Erreur !!!"
Data$ "Unable to Load "                         ; "Impossible de charger "
Data$ "Not enough Memory !!!"                   ; "Pas assez de memoire !!!"
Data$ "I'm not sure that's an E-Mail ?!?!"      ; "Je ne suis pas sur que ce soit un E-Mail ?!?!"
Data$ "Ok"                                      ; "Ok"
Data$ "Saving as Txt"                           ; "Sauvegarde fichier .cd"
Data$ "Attention !!!"                           ; "Attention !!!"
Data$ " exists, do U want overwrite it ?"       ; " existe, voulez-vous le remplacer ?"
Data$ "";""    ;
Data$ "";""    ;
Data$ "";""    ;  Au cas
Data$ "";""    ;  ou j'en
Data$ "";""    ;  ai besoin
Data$ "";""    ;  un jour ...
Data$ "";""    ;
Data$ "";""    ;
Data$ "Saving as Html"                          ; "Sauvegarde fichier .ct"
Data$ "- XFMProcess V1.0 -"                     ; "- XFMProcess V1.0 -"
Data$ "-------------------"                     ; "-------------------"
Data$ "By Xavier NUEL"                          ; "Par Xavier NUEL"
Data$ "22/10/1997 BadDolls Production"          ; "22/10/1997 BadDolls Production"
Data$ "The source of this litle"                ; "Le source de ce petit"
Data$ "program is on my Web Site ;-)"           ; "programme est sur mon site Web ;-)"
Data$ "Be free to do what you want with it.."   ; "Soyez libre d'en faire ce que vous voulez..."
Data$ "E-Mail : xn.baddolls@a2points.com"       ; "E-Mail : xn.baddolls@a2points.com"
Data$ "Homepage : www.a2points.com/homepage/3698138" ; "Homepage : www.a2points.com/homepage/3698138"

Even