[Gambas-user] Stiil problems with EVAL
Steven Lobbezoo
steven at ...1652...
Mon Sep 3 20:46:44 CEST 2007
Le lundi 3 septembre 2007 20:20, Benoit Minisini a écrit :
> On lundi 03 septembre 2007, Steven Lobbezoo wrote:
> > Le lundi 3 septembre 2007 18:09, Benoit Minisini a écrit :
> > > > Steven
> > >
> > > Can you send me your project?
> >
> > I tried :
> > gambas at ...1...
> > SMTP error from remote mailer after MAIL FROM:<steven at ...1764....>
> > SIZE=1084656:
> > host mail.sourceforge.net [66.35.250.206]: 552 Message size exceeds
> > maximum permitted
> >
> >
> > so, no dice.
> >
> > Steven
>
> Just remove what is useless. I just need a sample case to debug, because I
> cannot reproduce it.
>
> Regards,
Ok, here they are (hope it's complete)
Steven
-------------- next part --------------
' Gambas module file
PUBLIC db AS NEW Connection
PUBLIC rs AS Result
PUBLIC rs1 AS Result
PUBLIC btnok AS String
PUBLIC btnno AS String
PUBLIC Connected AS Integer
' the tree fields of the question form
PUBLIC QFld1 AS String
PUBLIC QFld2 AS String
PUBLIC QFld3 AS String
' these fields define the current user !
PUBLIC U_No AS Integer
PUBLIC U_Nom AS String
PUBLIC U_Agency AS Integer
PUBLIC U_AgenNom AS String
PUBLIC U_AgenRep AS String
PUBLIC U_AgenChef AS Integer ' the boss of the person logged in
PUBLIC U_Level AS Integer ' the level code of the person logged in
PUBLIC U_Mail AS String ' the e-mail of the user
PUBLIC U_Cell AS String ' the portable phone number
PUBLIC U_AgenStreet AS String ' the street adress of the agency
PUBLIC U_AgenPlz AS String ' and the postcode
PUBLIC U_AgenVille AS String ' and the town
PUBLIC U_AgenFax AS String ' and the fax number
PUBLIC U_AgenTel AS String ' and the agency's telephone number
PUBLIC V_Code AS Integer ' the current ville, selected from villes
PUBLIC M_Code AS String ' the current mandat code (new ?)
PUBLIC M_Sel_X AS Integer
PUBLIC M_Sel_Y AS Integer
PUBLIC F_Ch AS NEW String[]
PUBLIC FPath AS String = USER.Home ' the last path of the fileselector, remember this
PUBLIC JobTbl AS NEW Collection ' all Jobs available
PUBLIC Rev_Web AS String ' base path to the revimmo website
PUBLIC ParmsGen AS result ' the resultset of the read general parms
''''''''''''''''''''''''''''''''''
''sub to connect to mysql server''
''''''''''''''''''''''''''''''''''
PUBLIC FUNCTION conn(host AS String, lgn AS String, pass AS String) AS Boolean
db.close
db.Type = "mysql"
Connected = FALSE
db.Host = Host
db.Login = lgn
db.Password = pass
db.Open
Connected = TRUE
RETURN TRUE
CATCH
Message.error(error.text)
RETURN FALSE
END
''''''''''''''''''''''''''''''''''''''''
''sub to fill the tableview w/ records''
''''''''''''''''''''''''''''''''''''''''
PUBLIC SUB fill_view(tbv AS GridView, qry AS String)
DIM i AS Float
rs1 = db.exec(qry)
WITH rs1
tbv.rows.count = 0
IF .count <> 0 THEN
tbv.columns.count = .fields.count
tbv.rows.count = .count
END IF
END WITH
END
PUBLIC SUB set_jobs()
Mglobal.JobTbl.Add("1", "Négociatrice")
Mglobal.JobTbl.Add("2", "Chef d'agence")
Mglobal.JobTbl.Add("3", "Chef secteur")
Mglobal.JobTbl.Add("4", "Directeur")
Mglobal.JobTbl.Add("5", "Suppliant")
Mglobal.JobTbl.Add("6", "Carte seul")
Mglobal.JobTbl.Add("7", "Sécretaire")
Mglobal.JobTbl.Add("8", "Comptable")
Mglobal.JobTbl.Add("9", "Diverse")
END
PUBLIC FUNCTION MyVal(S AS String) AS Float
IF S THEN
RETURN Val(Replace(Replace(Replace(Replace(Replace(S, " ", ""), "€", ""), ")", ""), "(", ""), ".", ","))
ELSE
RETURN 0
END IF
END
PUBLIC FUNCTION Authorize(Level AS Integer) AS Integer
' we say if someone is authorised (we take the person level from U_.....
' There are 3 levels to be asked :
' 0: Négociatrices
' 1: respnsables agences et sécretaires
' 2: direction et compta
IF Level = 2 THEN
IF U_Level = 4 OR U_Level = 8 THEN
RETURN TRUE
ELSE
RETURN FALSE
ENDIF
ELSE IF Level = 1 THEN
IF (U_Level > 1) AND (U_Level <> 6) AND (U_Level <> 9) THEN
RETURN TRUE
ELSE
RETURN FALSE
ENDIF
ELSE IF Level = 0 THEN
IF U_Level <> 6 AND U_Level <> 9 THEN
RETURN TRUE
ELSE
RETURN FALSE
ENDIF
END IF
RETURN FALSE
END
PUBLIC FUNCTION GetComm(VenteNo AS Integer, Type AS String) AS String[]
' we fix the nego, son agence and the comm on a vente
' Type can be 'Vente', 'Mandat', 'Chef'
DIM hSql AS String
DIM rSet AS Result
DIM Rstr AS String[3]
IF Type = "Vente" THEN
hSql = "SELECT ((Jobs.comven * (Ventes.Comm_Vendue) / 1.196 - (Ifnull(Ded_1, 0) + Ifnull(Ded_2, 0) + Ifnull(Ded_3, 0))) / 100) " &
"* Mandats.ComFacteur AS commision, agents.agent as negolala, agences.repertoire as filia FROM Ventes, agents, agences, Jobs, Mandats " &
"where Ventes.No = " & Str(VenteNo) & " AND Ventes.Commercial = agents.id AND Jobs.Nego = Ventes.Commercial AND " &
"Jobs.Start < Ventes.Date AND " &
"(Jobs.End > Ventes.Date OR Ifnull(Jobs.End, 0) = 0) AND agences.no = Jobs.Filiale AND Mandats.Code = Ventes.Code_Mandat"
ELSE IF Type = "Mandat" THEN
ELSE IF Type = "Chef" THEN
END IF
rSet = db.Exec(hSql)
IF rSet.Available THEN
Rstr[0] = Format(rSet!Commision, "($,#.##)")
Rstr[1] = rSet!negolala
Rstr[2] = rSet!filia
END IF
RETURN Rstr
END
PUBLIC FUNCTION getmois(No AS Integer) AS String
DIM tmp AS String
SELECT CASE No
CASE 1
tmp = "Janvier"
CASE 2
tmp = "Février"
CASE 3
tmp = "Mars"
CASE 4
tmp = "Avril"
CASE 5
tmp = "Mai"
CASE 6
tmp = "June"
CASE 7
tmp = "Juillet"
CASE 8
tmp = "Aôut"
CASE 9
tmp = "Septembre"
CASE 10
tmp = "Octobre"
CASE 11
tmp = "Novembre"
CASE 12
tmp = "Décembre"
END SELECT
RETURN tmp
END
-------------- next part --------------
' Gambas module file
' Here we handle all xfers to and from open office files
' we have to do unzip, replace and zip into a new file
' we have to replace text items and images
' we have to insert images (replace really)
' the structure of an Oofile (unzipped) is analysed and data is transferred
' the tags are of the form {{TagType:String}}
' where Tagtype = 'db:' use DbFieldType
' 'cu:' Currency
' 'im:' Image
' 'tb:' Use translate table
' 'fo:' Formule (use + - / etc. for numeric database fields, all Mysql expressions are ok)
' 'ft:' Formatted text (nl etc !)
' 'li:' Litteral (program variable)
'
' The Mtranslate table is as followes :
' FieldName (VarChar) = Name of the query field
' FieldVal (VarChar) = Value of the field to translate
' Replacement (VarChar) = What to print (can be one of the above enumerated types, or just a value)
'
'
' We call this as OOInsert( Input file name, Output filename, SQl query string, Images string array) -> returns TRUE or FALSE
' if OFile is empty, the IFile will be written over (if I can !)
'
' Attention on the string Images : its format is as follows :
' [0]: ftp command for connection or file name like in
' "ftp ftp://root:pliplaplo@...1696..."
' or "localfile" &
' [1]: The location of the files as in
' "/home/steven/photos"
' or "/home/steven/{fieldname1}/test/{fieldname2}" where the vars {filednamex} are database field names
' from the query
' If a field in the databse, targeted for an image is a blob, we consider thats a transfert direct,
' otherwise, we will try to read the images from the location specified above, extenxded with the field contents
' as a file name
'
' All the other parms are in the document.
' In case of an image it's in the image-name field, followed by 2 numbers
' ie file_name01 - because OO can't have the same imagename twice (so, you have to put in a 'dummy' image)
'
' Attention : we presume someone opened a database db publicly
'
' now we do it
RsA AS Result ' the result of the databse quiry (if there are more records, you'll have more forms filles)
MYes AS String = "Oui"
MNo AS String = "Non"
sData AS String ' The input string of the XML file (the whole file)
FNam AS String ' The name of the temporary (work) file
MyDir AS String ' The working directory name
OSql AS String ' The original Quiry asked for
LImages AS String[] ' The command line for image transferts
PUBLIC PhotoNum AS Integer = -1 ' last photo number used, in case of multi photos
PUBLIC FUNCTION OOInsert(IFile AS String, OPTIONAL OFile AS String, Sql AS String, OPTIONAL Images AS String[]) AS Integer
DIM ZipCmd AS String
DIM Ctr AS Integer
' Main function, called from the outside
' IFile is the input openoffice text file name, OFile is the output target filename wanted
' here we do the main tasks, we will devide afterwards
' we presume that someone opened a database db
RsA = db.Exec(Sql)
IF NOT RsA.available THEN
message.Error(" There must be something wrong in your SQL statement:\n" & Sql & "\nor your database is not open\nOr there is data missing (photos ?)", "ok")
RETURN FALSE
END IF
IF NOT Access(IFile, gb.READ) THEN
message.Error(" There must be something wrong in your Filename:\n" & IFile & "\nI cannot read it", "ok")
RETURN FALSE
END IF
OSql = Sql ' save me, you never know !
' first we will save the images command (if there is any)
IF Images THEN
LImages = Images
END IF
IF NOT OFile THEN
OFile = IFile
END IF
FOR EACH RsA
' so we have our tools, lets try it
' we use unzip, since it knows how to handle directory structures
RANDOMIZE
FNam = Str(CInt(Rnd(100000000, 2000000000)))
MyDir = USER.Home & "/" & FNam
MKDIR MyDir
ZipCmd = "unzip -d " & MyDir & " " & IFile
' lets do the unzip
SHELL ZipCmd WAIT
' we have the structure unpacked now
' we have the following files to consider :
' content.xml = main content (text) with the tags
' ./Pictures directory with the images
' We start to read the content into a string
sData = File.Load(MyDir & "/content.xml")
sData = DoLine(sData) ' this is where the work is done
File.Save(MyDir & "/content.xml", sData)
' that main file is updated, we presume allso that all interesting photos are replaced in the Pictures directory
' and now we re-compress all into an odt (zip) file
SHELL "cd " & MyDir & ";zip -r " & FNam & ".odt *" WAIT
' ok, he's there now, lets move um and delete the working directory
IF Ctr = 0 THEN
SHELL "cp " & MYDir & "/" & FNam & ".odt " & OFile WAIT
ELSE
SHELL "cp " & MYDir & "/" & FNam & "_" & Str(Ctr) & ".odt " & OFile WAIT
END IF
SHELL "rm -rf " & MyDir ' we don't wait for this to end
Ctr = Ctr + 1
NEXT
RETURN TRUE
'CATCH
' Message.Error(Error.Text)
' SHELL "rm -rf " & MyDir ' try to clean up at least
' RETURN FALSE
END
PRIVATE FUNCTION DoLine(sData AS String) AS String
DIM s, e AS Integer
DIM Tmp AS String
DIM Tag AS String[]
' we do the replace/find data
Tmp = sData
s = InStr(Tmp, "{{")
WHILE s > 0
e = InStr(Tmp, "}}", s)
Tag = Split(Mid(Tmp, s + 2, e - s - 2), ":")
Tmp = Mid(Tmp, 1, s - 1) & DoField(Tag) & Mid(Tmp, e + 2)
s = InStr(Tmp, "{{")
WEND
RETURN Tmp
END
PRIVATE FUNCTION DoField(Tag AS String[]) AS String
DIM Rstr AS String ' the return string
DIM tmp AS String
DIM RsX AS Result
DIM TTag AS String[]
' we have the field to translate in tag, lets analyse it
' 0 is the command, 1 the value
Rstr = "--" ' just vin case, to avaoid null's comming out
SELECT Tag[0]
CASE "db" ' we take the field from the database, and try to print it as nice as possible
SELECT RsA.Fields[Tag[1]].Type
CASE db.Boolean
IF RsA[Tag[1]] THEN
Rstr = MYes
ELSE
Rstr = MNo
END IF
CASE db.integer
TRY Rstr = Format$(RsA[Tag[1]], "(#.#)")
CASE db.float
TRY Rstr = Format$(RsA[Tag[1]], "($,#)")
CASE db.date
TRY Rstr = Format$(RsA[Tag[1]], "d mmm yyyy")
CASE db.string
Rstr = XMLCor(RsA[Tag[1]])
CASE db.serial
Rstr = Str(RsA[Tag[1]])
CASE ELSE ' suppose this can be a blob or a string, w'll handle it as strings
Rstr = XMLCor(RsA[Tag[1]])
END SELECT
CASE "cu" ' currency "($,#.###)"
TRY Rstr = Format$(Str(RsA[Tag[1]]), "($,#.###)")
CASE "ft" ' formatted text
Rstr = XMLCor(RsA[Tag[1]])
CASE "im" ' image
DoPhotos(Tag) ' this is for the sequence number (2 pos)
Rstr = Tag[1]
CASE "li" ' Literal program variable
Rstr = XMLCor(Eval(Tag[1]))
' message.Info(Mglobal.U_AgenNom)
CASE "tb" ' translate table
' we read the table with Tag and value as the two keys
RsX = db.Exec("Select * from MTranslate where FieldName = '" & Tag[1] & "' AND FieldVal = '" & Str(RsA[Tag[1]]) & "'")
IF RsX.Available THEN
RStr = XMLCor(Conv(RsX!Replacement, "ISO-8859-1", "UTF-8"))
IF InStr(Rstr, ":") THEN
RStr = DoField(Split(RStr, ":")) ' we go deeeeep here, lets take the risc !
END IF
ELSE
RStr = " "
END IF
CASE "fo" ' we have to calculate something
' we have a string with + - / * etc in it and field names
' we adapt the first query, to add this calculation (field names must be ok !)
' we presume that the first query is like 'Select blablabla'
Tmp = "Select ( " & Replace$(Tag[1], "'", "'") & " ) as tmpnam2334, " & Mid(Osql, 7)
TRY RsX = db.Exec(Tmp)
IF RsX.available THEN
Rstr = XMLCor(RsX!tmpnam2334)
ELSE
RStr = ""
END IF
CASE ELSE
' we just try to give back the field (like string) after translation for xml
Rstr = XMLCor(RsA[Tag[1]])
END SELECT
RETURN Rstr
END
PRIVATE SUB DoPhotos(Tage AS String[])
' the problem is that there are more then one per document / record
' we will just do it as replacing existing images in their directory, without changing the xml
' the images in the xml files are as : href="Pictures/100000000000019D000001DC284D3F35.jpg"
DIM s, e, b AS Integer
DIM Tmp, Tmp2, FtpCom AS String
DIM Tag2 AS String[]
DIM hResultField AS ResultField
DIM Tres AS Result
DIM Tmp_fld AS String
PhotoNum = PhotoNum + 1
Tmp = sData
s = InStr(Tmp, "{{" & Tage[0] & ":" & Tage[1] & "}}")
s = InStr(Tmp, "href=\"Pictures/", s)
e = InStr(Tmp, " ", s) - 1
Tag2 = Split(Mid(Tmp, s + 15, e - s - 15), ".")
' we donnot change the text, we just move the picture in place
' the filename is in Tag[1]
' we read the photos table directly here
Tres = db.Exec("Select * from Photos where prop_num = " & RsA!id & " AND sequence = " & PhotoNum)
IF Tres.Available THEN
' ATTENTION ! we might have to change the file extension (png, gif, ...)
Tmp_fld = Mid$(Tage[1], 1, Len(Tage[1]) - 2)
IF Tres.Fields[Tmp_fld].Type = db.Blob THEN ' we have one direct ( a jpg, we will make)
Tmp2 = Tres[Tmp_fld]
' write the photo to local file
File.Save("'" & MyDir & "/Pictures/" & Tag2[0] & "." & Tag2[1] & "'", Tmp2)
ELSE 'we have a filename
' we will have to call a public user module, that gives us the full filename and
' it has to indicate if it's local or via ftp (with user and keys and so on)
IF LImages THEN
' we start with construction the file path
IF LImages[1] THEN
Tmp2 = LImages[1] ' the directory
s = InStr(Tmp2, "{")
IF s THEN ' we have some replace to do
WHILE s > 0
e = InStr(Tmp2, "}")
Tmp2 = Mid(Tmp2, 1, s - 1) & RsA[Mid(Tmp2, s + 1, e - s - 1)] & Mid(Tmp2, e + 1)
s = InStr(Tmp2, "{")
WEND
END IF
' we might have to clean Tmp_fld, since it might contain paths !
Tmp = Tres[Tmp_fld]
e = RInStr(Tmp, "/")
IF e > 0 THEN ' I thought so !
Tmp = Mid(Tmp, e + 1)
END IF
Tmp2 = Tmp2 & "/" & Tmp
ELSE
Tmp2 = Tmp_fld
END IF
' now we have the real file name in Tmp2
' we go and do the move
IF InStr(LImages[0], "ftp") > 0 THEN ' we have to construct a ftp command
FtpCom = LImages[0] & Tmp2 & "' -o '" & MyDir & "/Pictures/" & Tag2[0] & "." & Tag2[1] & "'"
SHELL FtpCom WAIT
' message.Info(FtpCom)
ELSE ' it's a local file
SHELL "cp -fp '" & Tmp2 & "' '" & MyDir & "/Pictures/" & Tag2[0] & "." & Tag2[1] & "'"
END IF
END IF
END IF
RETURN
ELSE
message.Info("C'est une fichier ancienne\nIl faut re-trier les photos !")
END IF
END
PRIVATE FUNCTION XMLCor(Inp AS String) AS String
DIM tmp AS String
'scan a string and prepare it for use with XML
Tmp = Replace$(Inp, "'", "'") ' Apostrophes (') are NOT allowed
Tmp = Replace$(Inp, "\"", """) ' Double quotes neither
Tmp = Replace$(Tmp, Chr$(9), "	") ' Horizontal tabs
Tmp = Replace$(Tmp, Chr$(10), "
") ' Line feeds
Tmp = Replace$(Tmp, Chr$(13), "") ' No carriage returns
RETURN Tmp
END
More information about the User
mailing list