[Gambas-user] Coding problem / bug ?

[Steven Lobbezoo]

You got it , the module is in the attachement.
It's on line 232 in DoPhotos

Steven
ps: I changed the var name into Tmp_fld (just a stupid try-out), but that 
changes nothing.

Le samedi 12 mai 2007 13:52, Benoit Minisini a écrit :
> On samedi 12 mai 2007, Steven Lobbezoo wrote:
> > 1.9.49 downloaded for 2 days from the trunk
> > Steven
>
> Can you send me more code? The full code of the module/form/class should be
> sufficient.
>
> Regards,
-------------- 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 (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
PhotoNum AS Integer     ' 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(Tag 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, "{{" & Tag[0] & ":" & Tag[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)
  
  
    ' ATTENTION ! we might have to change the file extension (png, gif, ...)
  Tmp_fld = Mid$(Tag[1], 1, Len(Tag[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
      Tmp2 = Tmp2 & "/" & Tres[Tmp_fld]
    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  
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