Di seguito lo sviluppo di un algoritmo per la conversione di un numero arabo in numero romano. Il testo romano viene generato da destra a sinistra


//u_DaAraboARomano
//--------------------------

If (Count parameters=0)
      $romano:=u_DaAraboARomano (87) //per test
Else
      $number:=$1
      $udigits:="IVXLCDM"
      $romano:=""
      $posizione:=1
      Repeat
           $modulo:=$number%10
           If (($modulo%5)<4)
           For ($i;($modulo%5);1;-1)
           $romano:=$udigits[[$posizione]]+$romano
           End for
           End if
           If (($modulo>=4) & ($modulo<=8))
           $romano:=$udigits[[$posizione+1]]+$romano
           End if
           If ($modulo=9)
           $romano:=$udigits[[$posizione+2]]+$romano
           End if
           If ($modulo%5=4)
           $romano:=$udigits[[$posizione]]+$romano
           End if
           $number:=Trunc($number/10;0)
           $posizione:=$posizione+2
      Until ($number<=0)
      $0:=$romano
End if

// calcola il check digit del codice ean
    // se il codice ean è di 8 o 13 caratteri elimino un carattere e ricalcolo il check digit

C_TEXT($check;$ritorno;$codice)
C_COLLECTION($strParts)
C_LONGINT($lngIndex;$intTotal;$intCount;$intUp As;$elementi;$modoup)

If (Undefined($1))
  $0:=""
End if

If ($1="")
  $0:=""
End if

$codice:=$1

If (Length($codice)=13)
  $codice:= prendiSinistra($codice;12)
End if

If (Length($codice)=8)
  $codice:= prendiSinistra($codice;7)
End if

$codice:=$codice+"C"
$strParts:=Split string($codice;"")
$elementi:=$strParts.length

For ($lngIndex;$elementi-2;0;-2)
  For ($intCount;1;3)
    $intTotal:=$intTotal+Num($strParts[$lngIndex])
  End for
End for

$lngIndex:=13

For ($lngIndex;$elementi-1;0;-2)
  $intTotal:=$intTotal+Num($strParts[$lngIndex])
End for

$intUp:=$intTotal

Repeat
  $intUp:=$intUp+1
  $modoup:=Mod($intUp;10)
Until ($modoup=0)

$check:=String($intUp-$intTotal)

For ($lngIndex;0;$elementi-2)
  $ritorno:=$ritorno+$strParts[$lngIndex]
End for

$ritorno:=$ritorno+$check
$0:=$ritorno


Sotto il codice per le funzioni prendiSinistra/prendiDestra


---- prendiSinistra ------
    // $1=testo
    // $2=lunghezza
    // $0=testo left

If ($2=0)
$0:=""
End if

C_LONGINT($lungo)
$lungo:=Length($1)
If ($lungo=0)
$0:=""
End if

$0:=Substring($1;1;$2)

---- prendiDestra ----
    // $1=testo
    // $2=lunghezza
    // $0=testo right

If ($2=0)
  $0:=""
End if

$lunghezza:=Length($1)
If ($lunghezza=0)
  $0:=""
End if

$lunghezza:=Length($1)

$0:=Substring($1;$lunghezza-$2+1;$2)

Ritorna il numero in formato lettera come ad esempio per gli assegni bancari :
1234,56 = MilleDuecentoTrentaQuattro//56

C_TEXT($result;$risultato;$intero)

    // il dato passato è un numero double che devo trasformare in un formato italiano
$intero:=String($1;"###########0.00")
    // $intero:=$1 // importo in lettere
C_TEXT($resto)
C_LONGINT($lungo)
$lungo:=Length($intero)
C_LONGINT($decimale)
$decimale:=Position(",";$intero)
$resto:="/"+tright ($intero;2)
$intero:=tleft ($intero;$decimale-1)
C_TEXT($verifica)
$verifica:=Substring($intero;1;1)
If ($verifica="-")
  $intero=Mid(intero, 2)
End if
If ($1=0)
  $0="zero/00"
End if
C_LONGINT($mille)
$mille:=-1
C_LONGINT($k)
$k:=Mod(Length($intero);3)
If ($k#0)
  $intero=Repeate (3-$k,"0")+$intero
End if

While ($intero#"")
  $mille:=$mille+1
  C_TEXT($parziale;$tripla;$s)
  C_LONGINT($tv;$td; $tc)
  C_LONGINT($x;$y)

  $tripla:=tright ($intero;3)
  $intero:=tleft ($intero;Length($intero)-3)
  $tv:=Num($tripla)
  $td:=Mod($tv;100)
  $tc:=($tv-$td)/100
  If (Not($tc=0)
    $parziale:="cento"
    If ($tc>1)
      $parziale:=unita ($tc)+$parziale
    End if
  End if
  If ($td<20)
    $parziale:=$parziale+unita ($td)
  Else
    $x:=Mod($td;10)
    $y:=($td-$x)/10
    $parziale:=$parziale+decine ($y)
    $s:=unita ($x)
    $primoc:=tleft ($s;1)
    $instr:=Position($primoc;"uo";1)

    If ($instr#0)
      If ($s#"")
        If (Not$y=0)
          $parziale:=tleft ($parziale;Length($parziale-1))
        End if
      End if
    End if

    $parziale:=$parziale+$s
  End if
  $s:=migliaia ($mille)
  If ($mille>0)
    If ($parziale#"")

      $k:=$mille
      If ($parziale#"uno")
        $k:=$k+4
        $s:=migliaia ($k)
        $ddestra:=tright ($parziale;3)
        If ($ddestra="uno")
          $parziale:=tleft ($parziale;Length($parziale)-1)
          End if
      Else
        $parziale:=""
      End if
      $parziale:=$parziale+$s
    End if
  End if
  $result:=$parziale+$result
End while

If ($1<0)
$result="meno"+$result
End if

$0:=$result+$resto


E di seguito le varie altre funzioni utilizzate :

--- Repeate ---

C_TEXT($testo)
C_LONGINT($contatore)
For ($contatore;1;$1)
  $testo:=$testo+$2
End for

$0:=$testo

--- unita ---

C_COLLECTION($lettere)
C_TEXT($risultato)
$lettere:=Split string(",uno,due,tre,quattro,cinque,sei,sette,otto,nove,dieci,undici,dodici,tredici,quattordici,quindici,sedici,diciassette,diciotto,diciannove";",")

C_LONGINT($lunghezza)
$lunghezza:=$lettere.length

If ($1<0)
$risultato:=""
Else
If ($1>$lunghezza)
$risultato:=""
Else
$risultato:=$Lettere[$1]
End if
End if

$0:=$risultato

--- migliaia ---

C_COLLECTION($lettere)

C_TEXT($risultato)
$lettere:=Split string(",mille,unmilione,unmiliardo,millemiliardi,mila,milioni,miliardi,milamiliardi,milamiliardi,migliaiadimiliardi";",")

C_LONGINT($lunghezza)

$lunghezza:=$lettere.length
If ($1<0)
$risultato:=""
Else
If ($1>$lunghezza)
$risultato:=""
Else
$risultato:=$Lettere[$1]
End if
End if

$0:=$risultato

--- isnumeric ---

If (Undefined($1))
$0=False
End if

$lettera:=$1
$numero:=Num($lettera)
$letteranunero:=String($numero)

If (Substring($lettera;1;1)="0")
$letteranunero:="0"+$letteranunero
End if

If (Length($lettera)=Length($letteranunero)
$0:=True
Else
$0:=False
End if

--- decine ----

C_COLLECTION($lettere)
C_TEXT($risultato)
C_LONGINT($lunghezza)

$lettere:=Split string(",dieci,venti,trenta,quaranta,cinquanta,sessanta,settanta,ottanta,novanta";",")
$lunghezza:=$lettere.length

If ($1<0)
$risultato:=""
Else
If ($1>$lunghezza)
$risultato:=""
Else
$risultato:=$Lettere[$1]
End if
End if
$0:=$risultato

--- tleft ----
    
    // $1=testo
    // $2=lunghezza
    // $0=testo left

If ($2=0)
$0:=""
End if

C_LONGINT($lungo)
$lungo:=Length($1)
If ($lungo=0)
$0:=""
End if

$0:=Substring($1;1;$2)

--- tright ---
    // $1=testo
    // $2=lunghezza
    // $0=testo right

If ($2=0)
$0:=""
End if

$lunghezza:=Length($1)
If ($lunghezza=0)
$0:=""
End if

$lunghezza:=Length($1)

$0:=Substring($1;$lunghezza-$2+1;$2)

Questo metodo ritorna Vero se il codice fiscale passato è scritto correttamente, utilizzando il carattere di controllo finale. La procedura è un po' condensata: per l'algoritmo di controllo completo potete trovare il dettaglio sul sito del Ministero delle Finanze.

    `Metodo Controllo_CodiceFiscale
    `controlla il checksum del codice fiscale
    `Nexus srl 4-6-90
C_LONGINT($i;$n_l;$car_l;$cod_l)
C_STRING(16;$cf_s;$1)
C_STRING(43;$mysndcod_s)
$cf_s:=$1
If (Length($cf_s)#16)
  $0:=False
Else
  $n_l:=0
  For ($i;2;14;2)
    $car_l:=Ascii($cf_s[[$i]])
    Case of
      : (($car_l>=48) & ($car_l<=57))
        $cod_l:=$car_l-48
      : (($car_l>=65) & ($car_l<=90))
        $cod_l:=$car_l-65
      Else
        $cod_l:=0
    End case
    $n_l:=$n_l+$cod_l
  End for
  $mysndcod_s:="BAFHJNPRTVUMBERTOBAFHJNPRTVCESULDGIMOQKWZYX"
  For ($i;1;15;2)
    $car_l:=Ascii($cf_s[[$i]])-47
    $cod_l:=Ascii($mysndcod_s[[$car_l]])-65
    $n_l:=$n_l+$cod_l
  End for
  $0:=((65+$n_l-(Int($n_l/26)*26))=Ascii($cf_s[[16]]))
End if

La funzione per il calcolo del codice fiscale :
Nota : occorre il database con i comuni e relativi codici istat.

---- calcolocodicefiscale ----

    // dati da passare per il calcolo
    // $1:Nome;$2:Cognome;$3:data in formato testo;$4:sesso M o F;$5:codice istat comune
    // ritorno il codice fiscale
$nome:=$1
$cognome:=$2
$data:=$3
$sesso:=$4
$comune:=$5

$inome:=""
$icognome:=""
$icomune:=""
$controllo:=""
$temp:=""
$letteracod:=""
    //prendi le iniziali del nome
    //ccc As int32=1
$lungnome:=0
For ($lungnome;1;Length($nome))
$temp:=Lowercase(Substring($nome;$lungnome;1))
Case of
: $temp="b"
$inome:=$inome+$temp
: $temp="c"
$inome:=$inome+$temp
: $temp="d"
$inome:=$inome+$temp
: $temp="f"
$inome:=$inome+$temp
: $temp="g"
$inome:=$inome+$temp
: $temp="h"
$inome:=$inome+$temp
: $temp="j"
$inome:=$inome+$temp
: $temp="k"
$inome:=$inome+$temp
: $temp="l"
$inome:=$inome+$temp
: $temp="m"
$inome:=$inome+$temp
: $temp="n"
$inome:=$inome+$temp
: $temp="p"
$inome:=$inome+$temp
: $temp="q"
$inome:=$inome+$temp
: $temp="r"
$inome:=$inome+$temp
: $temp="s"
$inome:=$inome+$temp
: $temp="t"
$inome:=$inome+$temp
: $temp="v"
$inome:=$inome+$temp
: $temp="w"
$inome:=$inome+$temp
: $temp="x"
$inome:=$inome+$temp
: $temp="y"
$inome:=$inome+$temp
: $temp="z"
$inome:=$inome+$temp

End case

End for

If (Length($inome)>=4)
$temp:=Lowercase($inome)
$inome:=Substring($temp;1;1)+Substring($temp;3;1)+Substring($temp;4;1)
End if

    //controlla la lunghezza delle iniziali
If (Length($inome)>3)
$inome:=Substring($inome;1;3)
Else
If (Length($inome)<3)
For $lungnome(1;Length($nome))
$letteracod:=Substring($nome;$lungnome;1)
Case of
: $letteracod="a"
$inome:=$inome+"a"
: $letteracod="e"
$inome:=$inome+"e"
: $letteracod="i"
$inome:=$inome+"i"
: $letteracod="o"
$inome:=$inome+"o"
: $letteracod="u"
$inome:=$inome+"u"
End case
End for

If (Length($inome)>3)
$inome:=Substring($inome;1;3)
If (Length($inome)<3)
For ($lungnome;Length($inome);3)
$inome:=$inome+"x"
End for
End if
End if
End if
End if

    // prendi lettere del cognome
For ($lungnome;1;Length($cognome))
$temp:=Lowercase(Substring($cognome;$lungnome;1))
Case of
: $temp="b"
$icognome:=$icognome+$temp
: $temp="c"
$icognome:=$icognome+$temp
: $temp="d"
$icognome:=$icognome+$temp
: $temp="f"
$icognome:=$icognome+$temp
: $temp="g"
$icognome:=$icognome+$temp
: $temp="h"
$icognome:=$icognome+$temp
: $temp="j"
$icognome:=$icognome+$temp
: $temp="k"
$icognome:=$icognome+$temp
: $temp="l"
$icognome:=$icognome+$temp
: $temp="m"
$icognome:=$icognome+$temp
: $temp="n"
$icognome:=$icognome+$temp
: $temp="p"
$icognome:=$icognome+$temp
: $temp="q"
$icognome:=$icognome+$temp
: $temp="r"
$icognome:=$icognome+$temp
: $temp="s"
$icognome:=$icognome+$temp
: $temp="t"
$icognome:=$icognome+$temp
: $temp="v"
$icognome:=$icognome+$temp
: $temp="w"
$icognome:=$icognome+$temp
: $temp="x"
$icognome:=$icognome+$temp
: $temp="y"
$icognome:=$icognome+$temp
: $temp="z"
$icognome:=$icognome+$temp
End case
End for

    // controlla la lunghezza delle iniziali
If (Length($icognome)>3)
$icognome:=Substring($icognome;1;3)
Else
If (Length($icognome)<3)
// minore di tre cifre prendi anche le vocali
For ($lungnome;1;Length($cognome))
letteracod:=Substring($cognome;$lungnome;1)
Case of
: $letteracod="a"
$icognome:=$icognome+"a"
: $letteracod="e"
$icognome:=$icognome+"e"
: $letteracod="i"
$icognome:=$icognome+"i"
: $letteracod="o"
$icognome:=$icognome+"o"
: $letteracod="u"
$icognome:=$icognome+"u"
End case
End for

If (Length($icognome)>3)
$icognome:=Substring($icognome;1;3)
Else
If (Length($icognome)<3)
For ($lungnome;Length($icognome);3)
$icognome:=$icognome+"x"
End for
End if
End if
End if
End if

    // Dim idata, gg, mm, aa As String
    // temp=data
    // Dim tempn As string

ARRAY TEXT($ddata;0)
C_COLLECTION($detta)

$detta:=Split string($data;"/")
COLLECTION TO ARRAY($detta;$ddata)

$gg:=$ddata{1}
$mm:=$ddata{2}
If (Length($ddata{3})=2)
$aa:=$ddata{3}
Else
$aa:=Substring($ddata{3};3;2)
End if

$idata:=$aa
    //MsgBox("TEMP"+temp)
Case of
: $mm="01"
$idata:=$idata+"a"
: $mm="02"
$idata:=$idata+"b"
: $mm="03"
$idata:=$idata+"c"
: $mm="04"
$idata:=$idata+"d"
: $mm="05"
$idata:=$idata+"e"
: $mm="06"
$idata:=$idata+"h"
: $mm="07"
$idata:=$idata+"l"
: $mm="08"
$idata:=$idata+"m"
: $mm="09"
$idata:=$idata+"p"
: $mm="10"
$idata:=$idata+"r"
: $mm="11"
$idata:=$idata+"s"
: $mm="12"
$idata:=$idata+"t"
End case
If ($sesso="M")
$idata:=$idata+$gg
Else
If ($sesso="F")

$idata:=$idata+String(Num($gg)+40)
End if
End if

C_LONGINT($vdis)

    // codice parziale per calcolare ultima cifra
$parz:=Lowercase($icognome+$inome+$idata+$comune)
    // trova il carattere di verificca
For ($lungnome;1;15;2)
$d:=Substring($parz;$lungnome;1)
Case of
: $d="0"
$vdis:=$vdis+1
: $d="1"
$vdis:=$vdis+0
: $d="2"
$vdis:=$vdis+5
: $d="3"
$vdis:=$vdis+7
: $d="4"
$vdis:=$vdis+9
: $d="5"
$vdis:=$vdis+13
: $d="6"
$vdis:=$vdis+15
: $d="7"
$vdis:=$vdis+17
: $d="8"
$vdis:=$vdis+19
: $d="9"
$vdis:=$vdis+21
: $d="a"
$vdis:=$vdis+1
: $d="b"
$vdis:=$vdis+0
: $d="c"
$vdis:=$vdis+5
: $d="d"
$vdis:=$vdis+7
: $d="e"
$vdis:=$vdis+9
: $d="f"
$vdis:=$vdis+13
: $d="g"
$vdis:=$vdis+15
: $d="h"
$vdis:=$vdis+17
: $d="i"
$vdis:=$vdis+19
: $d="j"
$vdis:=$vdis+21
: $d="k"
$vdis:=$vdis+2
: $d="l"
$vdis:=$vdis+4
: $d="m"
$vdis:=$vdis+18
: $d="n"
$vdis:=$vdis+20
: $d="o"
$vdis:=$vdis+11
: $d="p"
$vdis:=$vdis+3
: $d="q"
$vdis:=$vdis+6
: $d="r"
$vdis:=$vdis+8
: $d="s"
$vdis:=$vdis+12
: $d="t"
$vdis:=$vdis+14
: $d="u"
$vdis:=$vdis+16
: $d="v"
$vdis:=$vdis+10
: $d="w"
$vdis:=$vdis+22
: $d="x"
$vdis:=$vdis+25
: $d="y"
$vdis:=$vdis+24
: $d="z"
$vdis:=$vdis+23
End case
End for

C_LONGINT($vpar)

For ($lungnome;2;14;2)
$p:=Substring($parz;$lungnome;1)
Case of
: $p="0"
$vpar:=$vpar+0
: $p="1"
$vpar:=$vpar+1
: $p="2"
$vpar:=$vpar+2
: $p="3"
$vpar:=$vpar+3
: $p="4"
$vpar:=$vpar+4
: $p="5"
$vpar:=$vpar+5
: $p="6"
$vpar:=$vpar+6
: $p="7"
$vpar:=$vpar+7
: $p="8"
$vpar:=$vpar+8
: $p="9"
$vpar:=$vpar+9
: $p="a"
$vpar:=$vpar+0
: $p="b"
$vpar:=$vpar+1
: $p="c"
$vpar:=$vpar+2
: $p="d"
$vpar:=$vpar+3
: $p="e"
$vpar:=$vpar+4
: $p="f"
$vpar:=$vpar+5
: $p="g"
$vpar:=$vpar+6
: $p="h"
$vpar:=$vpar+7
: $p="i"
$vpar:=$vpar+8
: $p="j"
$vpar:=$vpar+9
: $p="k"
$vpar:=$vpar+10
: $p="l"
$vpar:=$vpar+11
: $p="m"
$vpar:=$vpar+12
: $p="n"
$vpar:=$vpar+13
: $p="o"
$vpar:=$vpar+14
: $p="p"
$vpar:=$vpar+15
: $p="q"
$vpar:=$vpar+16
: $p="r"
$vpar:=$vpar+17
: $p="s"
$vpar:=$vpar+18
: $p="t"
$vpar:=$vpar+19
: $p="u"
$vpar:=$vpar+20
: $p="v"
$vpar:=$vpar+21
: $p="w"
$vpar:=$vpar+22
: $p="x"
$vpar:=$vpar+23
: $p="y"
$vpar:=$vpar+24
: $p="z"
$vpar:=$vpar+25
End case

End for

    // somma dei valori ottenuti dal dispari e dal pari
$vdisparsomma:=$vdis+$vpar
    // ---------------------
    // vdisparsomma=148
    // ---------------------
    // diviso 26, troviamo il resto
$restov:=Mod($vdisparsomma;26)

Case of $restov
: $restov=0
$controllo:="a"
: $restov=1
$controllo:="b"
: $restov=2
$controllo:="c"
: $restov=3
$controllo:="d"
: $restov=4
$controllo:="e"
: $restov=5
$controllo:="f"
: $restov=6
$controllo:="g"
: $restov=7
$controllo:="h"
: $restov=8
$controllo:="i"
: $restov=9
$controllo:="j"
: $restov=10
$controllo:="k"
: $restov=11
$controllo:="l"
: $restov=12
$controllo:="m"
: $restov=13
$controllo:="n"
: $restov=14
$controllo:="o"
: $restov=15
$controllo:="p"
: $restov=16
$controllo:="q"
: $restov=17
$controllo:="r"
: $restov=18
$controllo:="s"
: $restov=19
$controllo:="t"
: $restov=20
$controllo:="u"
: $restov=21
$controllo:="v"
: $restov=22
$controllo:="w"
: $restov=23
$controllo:="x"
: $restov=24
$controllo:="y"
: $restov=25
$controllo:="z"
End case
    // fai il codice fiscale
$codicefiscale:=Uppercase($parz+$controllo)
$0:=$codicefiscale

// ritorna i dati da una tabella non correlata
    // $1 campo, $2 chiave, $3 tabella, $4 $filtro

C_TEXT($campo) // è il campo che utilizzo per la ricerca
C_TEXT($chiave) // è la chiave cioè il campo che voglio sia ritornato
C_TEXT($tabella) // è il nome della tabella per la quale voglio effettuare la ricerca
C_TEXT($filtro) // eventuale filtro WHERE
C_TEXT($risultato)
$campo:=$1
$chiave:=$2
$tabella:=$3
$filtro:=$4

SQL LOGIN(SQL_INTERNAL;"";"")

C_LONGINT($ffiltro)
$ffiltro:=Position($filtro;"%")
If ($ffiltro>0)
  $filtro:=Char(Quote)+$filtro+Char(Quote)
  SQL EXECUTE("SELECT DISTINCT "+$chiave+" FROM "+$tabella+" WHERE "+$campo+" LIKE "+$filtro;$risultato)
Else
  $filtro:=Char(Quote)+$filtro+Char(Quote)
  SQL EXECUTE("SELECT DISTINCT "+$chiave+" FROM "+$tabella+" WHERE "+$campo+" = "+$filtro;$risultato)
End if

SQL LOAD RECORD(SQL all records)
SQL LOGOUT

$0:=$risultato{0}

Il presente codice serve per ricavare il codice binario del codice 2 of 5 per poter poi disegnare il barcode in SVG (0) linea sottile, (1) linea spessa

C_TEXT($K)
C_TEXT($strCode)
C_TEXT($strAux)
C_TEXT($strExit)

$strCode:=$1
$strAux:=$strCode

If ($strCode="")
$0:=""
End if

For ($K=1;(Length($strCode))
C_TEXT($codice)
$codice:=Substring($strAux;$K;1)
Case of
: $codice="0"
: $codice="1"
: $codice="2"
: $codice="3"
: $codice="4"
: $codice="5"
: $codice="6"
: $codice="7"
: $codice="8"
: $codice="9"
: $codice="@"
: $codice="§"
// ok il codice non contiene caratteri non validi
Else
Alert("Errore il codice interleave 2 of 5 contiene caratteri non ammessi, sono ammessi solo numeri da 0-9)
$0:=""
End case
End for

For($K;1;length($strCode))
C_TEXT($codice)
$codice:=Substring($strCode;$K;1)
Case of
: ="1"
$strExit:=$strExit+"11010010010110"
: ="2"
$strExit:=$strExit+"11010101001100"
: ="3"
$strExit:=$strExit+"11001010100110"
: ="4"
$strExit:=$strExit+"11010010100110"
: ="5"
$strExit:=$strExit+"10110100100110"
: ="6"
$strExit:=$strExit+"10011010101100"
: ="7"
$strExit:=$strExit+"10110010101100"
: ="8"
$strExit:=$strExit+"10011001010110"
: ="9"
$strExit:=$strExit+"10110100101100"
: ="0"
$strExit:=$strExit+"11001010010110"
: ="@"
$strExit:=$strExit+"10110010110010"
: ="§"
$strExit:=$strExit+"11010000000000"
End case
// salto
End for

$0:=$strExit

Funzione utile per ricavare una stringa come questa riferita al codice EAN 13 o EAN 8 : 00010100011010100111000110100100010100111010001101010111001011011001001110101110010100001101100101000

è possibile poi dividere la stringa e disegnare con SVG linee verticali di spessore normale (0) e spessore doppio (1) per ricavare l'immagine del barcode.

$1 è il codice EAN ( se è lungo 12 o 7 caratteri inserire anche il metodo checkdigit, lo trovate in questo forum).

C_LONGINT($K)
C_TEXT($strAux)
C_TEXT($strExit)
C_TEXT($strCode)
C_TEXT($strEANCode)
$strAux:=$1
$strEANCode:=$1

    // se ho passato il codice ean senza check digit lo calcolo
If (Length($strAux)=12)
  $strEANCode:=Ean138CheckDigit ($strEANCode)
Else
  If (Length($strAux)=7)
    $strEANCode:=Ean138CheckDigit ($strEANCode)
  End if
End if

$strAux:=$strEANCode

If (Not(isnumeric ($strAux)))
  ALERT("Attenzione, il barcode contiene caratteri non validi")
  $0:=""
End if


If (Length($strAux)=13)
      // verifico che sia un EAN 13
      // per prima cosa scarto la prima cifra che è lo stato di emissione(fare riferimento ad INDICOD '
  $strAux:=Substring($strAux;2)
  C_LONGINT($numero)
  $numero:=Num(tleft ($strEANCode;1))
  Case of
    : $numero=0
      $strCode:="000000"
    : $numero=1
      $strCode:="001011"
    : $numero=2
      $strCode:="001101"
    : $numero=3
      $strCode:="001110"
    : $numero=4
      $strCode:="010011"
    : $numero=5
      $strCode:="011001"
    : $numero=6
      $strCode:="011100"
    : $numero=7
      $strCode:="010101"
    : $numero=8
      $strCode:="010110"
    : $numero=9
      $strCode:="011010"
  End case
Else
  $strCode:="0000"
End if

    //
    //Il codice EAN inizia con un carattere iniziale
    //
$strExit:="000101"

    //
    //Prima metà del codice
    //
For ($K;1;Length($strAux)\2)
  
  C_TEXT($code)
  C_LONGINT($numero)
  
  $code:=Substring($strCode;$K;1)
  $numero:=Num(Substring($strAux;$K;1))
  Case of
    : $numero=0
      C_TEXT($temptext)
      If ($code="0")
        $temptext:="0001101"
      Else
        $temptext:="0100111"
      End if
      $strExit:=$strExit+$temptext
      
    : $numero=1
      C_TEXT($temptext)
      If ($code="0")
        $temptext:="0011001"
      Else
        $temptext:="0110011"
      End if
      $strExit:=$strExit+$temptext
      
    : $numero=2
      C_TEXT($temptext)
      If ($code="0")
        $temptext:="0010011"
      Else
        $temptext:="0011011"
      End if
      $strExit:=$strExit+$temptext
      
    : $numero=3
      C_TEXT($temptext)
      If ($code="0")
        $temptext:="0111101"
      Else
        $temptext:="0100001"
      End if
      $strExit:=$strExit+$temptext
      
    : $numero=4
      C_TEXT($temptext)
      If ($code="0")
        $temptext:="0100011"
      Else
        $temptext:="0011101"
      End if
      $strExit:=$strExit+$temptext
      
    : $numero=5
      C_TEXT($temptext)
      If ($code="0")
        $temptext:="0110001"
      Else
        $temptext:="0111001"
      End if
      $strExit:=$strExit+$temptext
      
    : $numero=6
      C_TEXT($temptext)
      If ($code="0")
        $temptext:="0101111"
      Else
        $temptext:="0000101"
      End if
      $strExit:=$strExit+$temptext
      
    : $numero=7
      C_TEXT($temptext)
      If ($code="0")
        $temptext:="0111011"
      Else
        $temptext:="0010001"
      End if
      $strExit:=$strExit+$temptext
      
    : $numero=8
      C_TEXT($temptext)
      If ($code="0")
        $temptext:="0110111"
      Else
        $temptext:="0001001"
      End if
      $strExit:=$strExit+$temptext
      
    : $numero=9
      C_TEXT($temptext)
      If ($code="0")
        $temptext:="0001011"
      Else
        $temptext:="0010111"
      End if
      $strExit:=$strExit+$temptext
      
  End case
End for

    //
    // Prosegue poi con un separatore di mezzo
    //

$strExit:=$strExit+"01010"

    //
    // Seconda metà del codice
    //

For ($K;Length($strAux)\2+1;Length($strAux))
  C_LONGINT($numero)
  $numero:=Num(Substring($strAux;$K;1))
  Case of
    : $numero=0
      $strExit:=$strExit+"1110010"
    : $numero=1
      $strExit:=$strExit+"1100110"
    : $numero=2
      $strExit:=$strExit+"1101100"
    : $numero=3
      $strExit:=$strExit+"1000010"
    : $numero=4
      $strExit:=$strExit+"1011100"
    : $numero=5
      $strExit:=$strExit+"1001110"
    : $numero=6
      $strExit:=$strExit+"1010000"
    : $numero=7
      $strExit:=$strExit+"1000100"
    : $numero=8
      $strExit:=$strExit+"1001000"
    : $numero=9
      $strExit:=$strExit+"1110100"
  End case
End for

    // Il Codice EAN finisce con un separatore finale

$strExit:=$strExit+"101000"

$0:=$strExit

Gli sconti composti sono gli sconti commerciali ad esempio 50+20+3 oppure 50+20-3 ( applico lo sconto del 50+20 con un amento del 3% ).

per l'utilizzo :
$importoscontato:=scontocommerciale(126.34,"50+20+3")

--- scontocommerciale ---

    // ricava lo sconto in base alla stringa
    // $1 importo
    // $2 sconto
    // ritorno l'importo scontato su $0

If ($2="")
  If ($1=0)
    $0:=0
  Else
    $0:=$1
  End if
End if


$scontotxt:=$2
$scontotxt:=Replace string($scontotxt;"+";"§+")
$scontotxt:=Replace string($scontotxt;"-";"§-")

C_COLLECTION($sconti)
ARRAY TEXT($ssconti;0)
C_REAL($importoscontato;$scontopercento)

$sconti:=Split string($scontotxt;"§")
COLLECTION TO ARRAY($sconti;$ssconti)

$elementi:=Size of array($ssconti)
$importoscontato:=$1

For ($contatore;1;$elementi)
  $scontopercento:=Num($ssconti{$contatore})
  $sconto:=$importoscontato*$scontopercento/100
  $importoscontato:=$importoscontato-$sconto
End for

$0:=$importoscontato

Nella v13:

$0:=System Folder(Documents folder)


Nella v12:

// Codice di Maurizio Zanni

C_TEXT($_vt_Path)

C_LONGINT($_vl_Type)
$_vl_Type:=Desktop

//Ritorna il Path del Desktop
$_vt_Path:=System Folder($_vl_Type)

//Elimina il Separatore alla fine del Path
$i:=Length($_vt_Path)
$_vt_Path:=Substring($_vt_Path;1;$i-1)

//Ritorna il Path alla cartella Padre del Desktop
$i:=Length($_vt_Path)
While ($_vt_Path≤$i≥#Folder Separator) & ($i>0)
        $i:=$i-1
End while
$_vt_Path:=Substring($_vt_Path;1;$i-0)

//Aggiunge la Cartella Documents con il Separatore finale (Mac o Win)
$_vt_Path:=$_vt_Path+"Documents"+Folder Separator

$0:=$_vt_Path

Il formato XML plist è lo standard con cui sono scritte ad esempio le preferenze dei vari programmi su Mac OS X.

Il formato è letto nativamente dalle applicazioni scritte in XCode, come ad esempio programmi per iPhone e iPad.

L'esempio successivo mostra come creare una plist per ad esempio inviare dei dati strutturati ad un applicativo su iOS in modo semplice e veloce: infatti un xml generico andrebbe ogni volta interpretato, mentre la plist può essere letta direttamente come un NSDictionary.

    ` ----------------------------------------------------
    ` User name (OS): Umberto Migliore
    ` Date and time: 08-02-11, 12:22:51
    ` ----------------------------------------------------
    ` Method: nx_crea_plist
    ` Description:
    `mostra come creare un documento plist:
    `
    `<?xml version="1.0" encoding="UTF-8" standalone="no" ?>
    `<!DOCTYPE plist PUBLIC "-//Apple//DTD PLIST 1.0//EN" "http://www.apple.com/DTDs/PropertyList-1.0.dtd">
    `<plist version="1.0">
    ` <dict>
    ` <key>Author</key>
    ` <string>William Shakespeare</string>
    ` <key>Title</key>
    ` <string>Macbeth</string>
    ` <key>Lines</key>
    ` <array>
    ` <string>It is a tale told by an idiot,</string>
    ` <string>Full of sound and fury, signifying nothing.</string>
    ` </array>
    ` <key>Birthdate</key>
    ` <integer>1564</integer>
    ` </dict>
    `</plist>
    `
    ` Parameters
    ` ----------------------------------------------------
C_TEXT($autore;$titolo)
C_LONGINT($annonascita)
ARRAY TEXT($citazione;0)

    `=== preparo i dati
$autore:="William Shakespeare"
$titolo:="Macbeth"
$annonascita:=1564
APPEND TO ARRAY($citazione;"It is a tale told by an idiot,")
APPEND TO ARRAY($citazione;"Full of sound and fury, signifying nothing.")

    `=== creo la plist
$xml_ref:=DOM Create XML Ref("plist";"";"version";"1.0")

    `=== dict principale che contiene tutto
$dict:=DOM Create XML element($xml_ref;"dict")

$key:=DOM Create XML element($dict;"key")
DOM SET XML ELEMENT VALUE($key;"Author")
$value:=DOM Create XML element($dict;"string")
DOM SET XML ELEMENT VALUE($value;$autore)

$key:=DOM Create XML element($dict;"key")
DOM SET XML ELEMENT VALUE($key;"Title")
$value:=DOM Create XML element($dict;"string")
DOM SET XML ELEMENT VALUE($value;$titolo)

$key:=DOM Create XML element($dict;"key")
DOM SET XML ELEMENT VALUE($key;"Lines")
$array:=DOM Create XML element($dict;"array")
For ($riga;1;Size of array($citazione))
  $value:=DOM Create XML element($array;"string")
  DOM SET XML ELEMENT VALUE($value;$citazione{$riga})
End for

$key:=DOM Create XML element($dict;"key")
DOM SET XML ELEMENT VALUE($key;"Birthdate")
$value:=DOM Create XML element($dict;"integer")
DOM SET XML ELEMENT VALUE($value;$annonascita)

    `=== chiude l'xml, aggiunge lo header e ritorna un testo
DOM EXPORT TO VAR($xml_ref;$testo)
DOM CLOSE XML($xml_ref)
$header:="<!DOCTYPE plist PUBLIC \"-//Apple//DTD PLIST 1.0//EN\" \"http://www.apple.com/DTDs/PropertyList-1.0.dtd\">\n"
$testo:=Insert string($testo;$header;Position("<plist";$testo))

ALERT($testo)  ` $0:=$testo

Questo codice è un esempio di utilizzo del componente incluso in 4d per gestire i comandi SVG; lo scopo del metodo è di ruotare di 90 gradi un'immagine, ad esempio per raddrizzare una foto.

    // ----------------------------------------------------
    // User name (OS): Umberto Migliore
    // Date and time: 14-02-11, 11:41:14
    // ----------------------------------------------------
    // Method: nx_svgRuotaQuartoDestra
    // Description
    // Ruota un immagine di un quarto di giro a destra
    //
    // Parameters
    // ----------------------------------------------------

C_PICTURE($immagine;$1;$0)
$immagine:=$1
PICTURE PROPERTIES($immagine;$larga;$alta)
$maggiore:=Choose($larga>$alta;$larga;$alta)
$svg:=SVG_New ($alta;$larga)
$img:=SVG_New_embedded_image ($svg;$immagine;0;0)
SVG_SET_TRANSFORM_ROTATE ($svg;90;$maggiore/2;$maggiore/2)
If ($larga>$alta)
  SVG_SET_TRANSFORM_TRANSLATE ($svg;0;$larga-$alta)
End if
$immagine:=SVG_Export_to_picture ($svg;0)
SVG_CLEAR ($svg)
$0:=$immagine

Come tutti sappiamo, la funzione Position() di 4D restituisce la posizione del primo carattere trovato, ma partendo da sinistra.

In giro ho trovato questo ciclo per trovare la posizione della prima occorrenza di una stringa inclusa in un'altra a partire dalla destra della stringa.
Un po come InStrRev di VB.

C_INTEGER($Pos;$start;$lengthfound;$Result)
C_TEXT($Temp)
  // Ricava la path della cartella preferenze
// Replace string(... Aggiunge un Folder separator alla stringa ricavata:
// Se Folder separator esiste, sostituisce i due Folder separator risultanti con una stringa vuota
// Se Folder separator esiste, non fa' nulla
// In ogni caso la stringa ricavata non terminerà con Folder separator !

$Temp:=Replace string(Get 4D folder(Active 4D Folder)+Folder separator;Folder separator+Folder separator;"")
$Pos:=0
$start:=1
Repeat
  $Result:=Position(Folder separator;$Temp;$start;$lengthfound)
  If ($Result#0)
    $Pos:=$Result
  End if
  $start:=$start+$lengthfound
Until ($Result=0)
<>g_PathPreferences:=Substring($Temp;1;Length(Substring($Temp;1;$Pos)))+Folder separator

Sicuramente funzionante ma, a mio avviso, un po' troppo 'contorta'.
Si puo' semplificare cosi:
    
C_TEXT($Temp)
C_INTEGER($Conta)
    // Ricava la path della cartella preferenze
$Temp:=Replace string(Get 4D folder(Active 4D Folder)+Folder separator;Folder separator+Folder separator;"")
For ($Conta;Length($Temp);1;-1)
  If (Substring($Temp;$Conta;1)=Folder separator)
    $Temp:=Substring($Temp;1;$Conta)
    $Conta:=1
  End if
End for
<>g_PathPreferences:=$Temp+Folder separator

Oltre ad avere un codice piu' leggibile, abbiamo risparmiato tre righe di procedura (a parte le note) e dichiarato
due variabili contro cinque della procedura precedente.

Non è il massimo ...ma con la crisi che incombe, bisogna centellinare tutto.

Il testo in 4d era in Mac ASCII fino alla versione 2004, dalla v11 è in UTF-16 (a meno che non abbiate lasciato la compatibilità Ascii del db)

Quando si esporta un file in Unicode è necessario normalmente indicare in che formato sono i caratteri che occupano 2 byte (big-endian o little-endian) con un prefisso chiamato un BOM (Byte Order Mark). In realtà in UTF-8 si tende ad esportare i caratteri in byte singoli quindi in linea di massima non ci sono problemi di ordinamento dei byte, e non servirebbe.

Però alcune applicazioni se lo aspettano comunque, quindi a volte è necessario aggiungerlo, come ad esempio con questa procedura:

C_TEXT($1;$testo_t)
C_BLOB($blob_b;$bom_b)

$testo_t:=$1

SET BLOB SIZE($bom_b;3)
$bom_b{0}:=239 ` EF
$bom_b{1}:=187 ` BB
$bom_b{2}:=191 ` BF

CONVERT FROM TEXT($testo_t;"UTF-8";$blob_b)

$doc_h:=Create document("")
If (OK=1)
  SEND PACKET($doc_h;$bom_b)
  SEND PACKET($doc_h;$blob_b)
  CLOSE DOCUMENT($doc_h)
End if

Uso questo metodo nell'oggetto Popup cmb_Cliente che risolve velocemente il problema del valore di default quando un database è completamente vuoto.

Case of
  : (Form event=On Load)
  ARRAY LONGINT(cmb_CodCliente;0)
  ARRAY TEXT(cmb_Cliente;0)

  ALL RECORDS([Clienti])
  SELECTION TO ARRAY([Clienti]Progressivo;cmb_CodCliente; [Clienti]Rag_Sociale;cmb_Cliente)
  If (Size of array(cmb_CodCliente)>0)
    If (Is new record([Stabilimenti])) //nuova scheda
      cmb_Cliente:=1 //mostra un valore di default
      cmb_CodCliente:=cmb_Cliente
    Else //se ci sono record, cerca il codice nel vettore cmb_CodCliente
      // Se Find in array ritorna -1 verrà generato un errore
      // Usando Abs(Find in array..... restituira -1 (quindi 1)
      cmb_CodCliente:=Abs(Find in array(cmb_CodCliente;[Stabilimenti]Cod_Cliente))
      cmb_Cliente:=cmb_CodCliente
    End if
  End if
  : (Form event=On Clicked)
  If (cmb_Cliente#0)
    cmb_CodCliente:=cmb_Cliente
    [Stabilimenti]Cod_Cliente:=cmb_CodCliente{cmb_CodCliente}
  End if
  : (Form event=On Unload)
    CLEAR VARIABLE(cmb_CodCliente)
    CLEAR VARIABLE(cmb_Cliente)
End case

Il formato XML di data e ora è il seguente AAAA-MM-GGTHH:MM:SS.

Il vantaggio di questa stringa è che è ordinabile, contiene la coppia dei dati e quindi è più leggibile del timestamp (che rimane però più efficiente e consuma meno spazio su disco e in memoria come indice).

Ecco alcuni trucchi per convertire una data in questo formato e viceversa (non documentati, mi sembra) in 4d 2004.3:

Date("2006-01-24T00:00:00") -> ritorna effettivamente la data 24 gen 2006: Importante funziona solo se la stringa è lunga 19 caratteri e la data è seguita dal separatore "T".

String(current date;8) -> ritorna la data nel formato XML completa di separatore = "2006-01-24T00:00:00"

Per avere data e ora si può usare questa semplice riga:

Replace string(String(Current date;8);"00:00:00";String(Current time;1))

Il seguente metodo prende come parametri il puntatore ad una listbox, il separatore fra le colonne e quello fra le righe per inserire negli appunti il contenuto della listbox stessa.


C_POINTER($1;$lbPointer_p)
C_TEXT($2;$columnSeparator_t)
C_TEXT($3;$rowSeparator_t)

C_LONGINT($i;$numRows_l)
C_LONGINT($j;$numCols_l)
C_TEXT($theData_t)

ARRAY TEXT($colNames_at;0)
ARRAY TEXT($headerNames_at;0)
ARRAY POINTER($colVars_ap;0)
ARRAY POINTER($headerVars_ap;0)
ARRAY BOOLEAN($colsVisible_ab;0)
ARRAY POINTER($styles_ap;0)

$lbPointer_p:=$1

If (Count parameters>1)
      $columnSeparator_t:=$2
        $rowSeparator_t:=$3
Else
        $columnSeparator_t:=Char(Tab)
        $rowSeparator_t:=Char(Carriage return)
End if

LISTBOX GET ARRAYS($lbPointer_p->;$colNames_at;$headerNames_at;$colVars_ap;$headerVars_ap;$colsVisible_ab;$styles_ap)

$numRows_l:=Size of array($colVars_ap{1}->)
$numCols_l:=Size of array($colNames_at)

For ($i;1;$numRows_l)

      For ($j;1;$numCols_l)
           If ($colsVisible_ab{$j}=True)
           If ($j#1)
           $theData_t:=$theData_t+$columnSeparator_t
           End if
           $theData_t:=$theData_t+String($colVars_ap{$j}->{$i})
           End if
      End for

      If ($i<$numRows_l)
           $theData_t:=$theData_t+$rowSeparator_t
      End if

End for

SET TEXT TO PASTEBOARD($theData_t)


-----------

Da notare come:
- il comando String può ricevere come parametro anche una stringa;
- per testi grandi il testo potrebbe essere prima inserito il un BLOB.

Col seguente metodo l'array URL_a viene popolato con gli URL che contiene myString:

ARRAY LONGINT(posFound_a;0)
ARRAY LONGINT(lengthFound_a;0)
ARRAY TEXT(URL_a;0)
C_LONGINT($start)
C_TEXT($mySubstring;myString;$1)
C_TEXT(stringNew; pattern)
C_BOOLEAN($found)

myString:=$1
$start:=1
$found:=False
pattern:="(http|https|ftp)" ` http o https, o ftp.
pattern:=pattern + "\\://" ` ://
pattern:=pattern + "[a-zA-Z0-9\\-\\.]+" `la prima parte del dominio
pattern:=pattern + "\\.[a-zA-Z]{2,4}" `la seconda parte
pattern:=pattern + "(:[a-zA-Z0-9]*)?/?" `la porta e lo slash
pattern:=pattern + "([a-zA-Z0-9\\-\\._?\\,'/\\+%\\$#\\=~\\:\\&])*" `Caratteri riservati
pattern:=pattern + "[^\\.\\,\\)\\(\\s\\']" `Caratteri da escludere
Repeat
  $found:=Match regex(pattern;myString;$start;posFound_a;lengthFound_a)
  stringNew:=Substring(myString;posFound_a{0};lengthFound_a{0})
  If ($found)
    APPEND TO ARRAY(URL_a;stringNew)
  End if
  $start:=posFound_a{0}+lengthFound_a{0}
Until (Not($found))

Utilizzando i comandi SQL è possibile interrogare la tabella di sistema _USER_CONSTRAINTS per ottenere in una listbox chiamata ListBox_Relations l'elenco di tutte le relazioni presenti in un database o loro proprietà.

-----
Un primo esempio

Begin SQL
  SELECT * FROM _USER_CONSTRAINTS
  WHERE CONSTRAINT_TYPE = 'P'
  INTO LISTBOX :miaListBox;
End SQL

per ottenere l'elenco di tutte le chiavi primarie utilizzate.
-----
Un secondo esempio

Begin SQL
  SELECT * FROM _USER_CONSTRAINTS
  WHERE CONSTRAINT_TYPE = 'R'
  INTO LISTBOX :miaListBox;
End SQL

per l'elenco delle chiavi esterne.

-----
Per l'elenco completo


Begin SQL
  SELECT * FROM _USER_CONSTRAINTS
  INTO LISTBOX :miaListBox;
End SQL

Nella v12 è possibile usare database esterni: ecco un esempio veloce per trasferire i dati da una tabella locale nell'equivalente tabella sul db esterno.


ALL RECORDS([Tabella])
SQL EXPORT SELECTION([Tabella];$percorsoAppoggio)

Begin SQL
      USE DATABASE DATAFILE :$percorsoDB;
End SQL

$importa:=$percorsoAppoggio+Folder separator+
importa:=importa+"SQLExport"+Folder separator
importa:=importa+"Export.sql"

SQL EXECUTE SCRIPT($importa;SQL On error abort)

Begin SQL
      USE DATABASE SQL_INTERNAL;
End SQL

Ecco di seguito il codice di un pulsante che permette di stampare il contenuto di una Rich Text Area memorizzato nel campo [Tabella]MioTesto:

Case of
      : (Form event=On Clicked)

      PRINT SETTINGS

      If (ok=1)
           OPEN PRINTING JOB

           If (ok=1)
           OPEN PRINTING FORM("Form1")
           vStampa:=OBJECT Get styled text([Tabella]MioTesto)
           $complete_b:=Print object(*;"vStampa")
           CLOSE PRINTING JOB
           End if
      End if
End case

Per modificare l'elemento di una list box è necessario cliccarci due volte: il primo clic seleziona l'elemento, il secondo lo rende modificabile. Per fare in modo che un clic renda direttamente modificabile l'elemento si può uasre il seguente codice:

Case of
: (Form event=On Clicked )
    ` mi asssicuro che non stia facendo una selezione mutipla
      If (Not(Shift down | Windows Ctrl down))
           LISTBOX GET CELL POSITION(*;"ListBox";col;row;colVar_p)
           EDIT ITEM(colVar_p->;row)
      End if
End case

Ecco un esempio di utilizzo di Match regex per verificare un indirizzo tcp/ip ed estrarne le diverse cifre.

Si basa su:
- il simbolo \d = una cifra
- gli operatori {min,max} indicano quante ripetizioni cercare
- gli operatori () isolano i diversi gruppi trovati

    // ----------------------------------------------------
    // User name (OS): Umberto Migliore
    // Date and time: 01-03-11, 23:48:44
    // ----------------------------------------------------
    // Method: regex
    // Description
    //
    //
    // Parameters
    // ----------------------------------------------------

ARRAY LONGINT($arrayPosizioni;0)
ARRAY LONGINT($arrayLunghezze;0)
C_BOOLEAN(isTcpCorretto)
C_TEXT($stringa;$1)

$stringa:=$1` per esempio "192.168.0.1"

isTcpCorretto:=Match regex("(\\d{1,3})\\.(\\d{1,3})\\.(\\d{1,3})\\.(\\d{1,3})";$stringa;1;$arrayPosizioni;$arrayLunghezze)

If (isTcpCorretto)
  $numero1:=Substring($stringa;$arrayPosizioni{1};$arrayLunghezze{1})
  $numero2:=Substring($stringa;$arrayPosizioni{2};$arrayLunghezze{2})
  $numero3:=Substring($stringa;$arrayPosizioni{3};$arrayLunghezze{3})
  $numero4:=Substring($stringa;$arrayPosizioni{4};$arrayLunghezze{4})
End if

Ecco, per finire, un estratto di codice per ricevere mai da GMail dal server POP.


$tempFolder:=Temporary folder
$error:=0
$sslPOPPort:=995
$Errore_l:=IT_SetPort (13;$sslPOPPort) //13 is for 'POP with SSL'
$error:=POP3_SetPrefs (-1;$tempFolder;$tempFolder)
$error:=POP3_BoxInfo ($pop3ID;$msgCount;$msgSize)
ARRAY LONGINT($aMsgSize;0)
ARRAY LONGINT($aMsgNum;0)
ARRAY TEXT($aMsgID;0)
$error:=POP3_MsgLstInfo ($pop3ID;1;$msgCount;$aMsgSize;$aMsgNum;$aMsgID)
For ($msgNumber;1;Size of array($aMsgNum))
`.......
`scarica la mail con POP3_Download
`cancellala con POP3_Delete
`scarica il messaggio con MSG_GetBody
`.......
End for
$error:=POP3_Logout ($pop3ID)

Ecco di seguito la parte di codice necessaria per autenticarsi al server IMAP di GMail e ricevere l'elenco dei messaggi di posta in entrata.


C_INTEGER($error;$sslIMAPPort)
C_LONGINT($smtp_id)
$tempFolder:=Temporary folder
$sslIMAPPort:=993
$error:=IT_SetPort (14;$sslIMAPPort) //14 is for 'IMAP with SSL'
$error:=IMAP_SetPrefs (-1;$tempFolder) //
$error:=IMAP_Login ("imap.gmail.com";"mymail@gmail.com";"mypassword";$imapID;1)

ARRAY LONGINT($aMsgSize;0)
ARRAY LONGINT($aMsgNum;0)
ARRAY LONGINT($aMsgID;0)
$error:=IMAP_SetCurrentMB ($imapID;"INBOX")
$error:=IMAP_MsgLstInfo ($imapID;1;$msgCount;$aMsgSize;$aMsgNum;$aMsgID)
$error:=IMAP_Logout ($imapID)

Grazie alle nuove funzionalità SSL degli Internet Command di 4D v12, è adesso possibile inviare messaggi attraverso il server smtp.gmail.com. Vediamo il metodo:


C_INTEGER($error;$sslSMTPPort)
C_LONGINT($smtp_id)
C_TEXT($smtpHost)
C_TEXT($gmailUser;$gmailPass;$replyTo;$sendEmailTo)
C_TEXT($msg;$subject)

$sslSMTPPort:=465 // port used for SSL SMTP - gmail wants 465
$smtpHost:="smtp.gmail.com" // smtp host for gmail
$gmailUser:="mymail@gmail.com" // gmail user
$gmailPass:="mypass" // gmail password
$replyTo:="mymail@gmail.com" // have replies sent here
$sendEmailTo:="test@sendmail.it" // send email here
$subject:="An example from sviluppo4d" // subject for email
$msg:="It works fine" // email body

$error:=IT_SetPort (12;$sslSMTPPort) //12 is for 'SMTP with SSL'

$error:=SMTP_New ($smtp_id)
$error:=SMTP_Host ($smtp_id;$smtpHost;0)
$error:=SMTP_Auth ($smtp_id;$gmailUser;$gmailPass;0)
$error:=SMTP_AddHeader ($smtp_id;"Importance";"Normal";0)
$error:=SMTP_From ($smtp_id;$gmailUser;1)
$error:=SMTP_ReplyTo ($smtp_id;$replyTo;0)
$error:=SMTP_To ($smtp_id;$sendEmailTo;0)
$error:=SMTP_Subject ($smtp_id;$subject;0)
$error:=SMTP_Body ($smtp_id;$msg;0)
$error:=SMTP_Attachment ($smtp_id;"c:\\aPDFdoc.pdf";7)
$error:=SMTP_Send ($smtp_id;1) //1 to use ssl
$error:=SMTP_Clear ($smtp_id)

// ----------------------------------------------------
    // User name (OS): Umberto Migliore
    // Date and time: 09-02-11, 23:55:55
    // ----------------------------------------------------
    // Method: nx_giornoPasquaPerLAnno
    // Description
    // Ritorna il giorno di Pasqua per l'anno
    //
    // Parameters
    // $1 = anno
    // ----------------------------------------------------

c_longint($anno;$1)
C_LONGINT($dopo21marzo)
C_DATE($pasqua;$0)

$anno:=$1
$phpok:=PHP Execute("";"easter_days";$dopo21marzo;$anno)
$pasqua:=Add to date(!00-00-00!;$anno;3;21+$dopo21marzo)
$0:=$pasqua

  ` ----------------------------------------------------
    ` User name (OS): Umberto Migliore
    ` Date and time: 02-02-11, 10:51:05
    ` ----------------------------------------------------
    ` Method: nx_GetMemory
    ` Description
    ` se non passi parametri mostra un alert con tutti i valori correnti
    ` se passi una delle seguenti stringhe ritorna il valore specifico in KB
    ` 
    ` es. nx_GetMemory
    ` es. $memoriadisponibile:=nx_GetMemory("Free Memory")
    `
    ` $1 può essere:
    ` "cacheSize"
    ` "usedCacheSize"
    ` "Physical Memory Size"
    ` "Free Memory"
    ` "Used physical memory"
    ` "Used virtual memory"
    ` ----------------------------------------------------


ARRAY TEXT($arrNomi;0)
ARRAY REAL($arrValori;0)
ARRAY REAL($arrOggetti;0)

GET CACHE STATISTICS(1;$arrNomi;$arrValori;$arrOggetti)

If (Count parameters=0)
  
  C_TEXT($testo)
  $testo:=""
  For ($i;1;Size of array($arrValori))
    $testo:=$testo+$arrNomi{$i}+" : "+String($arrValori{$i}/1024;"### ### ### KB")+Char(13)
  End for
  ALERT($testo)

Else  `Count parameters>0

  C_TEXT($1;$parametro)
  $pos:=Find in array($arrNomi;$parametro)
  If ($pos>0)
    $0:=$arrValori{$pos}/1024  `i valori sono in bytes
  Else
    $0:=-1
  End if

End if

Ecco un esempio di utilizzo della tabella interna _USER_COLUMNS per esportare la struttura del database corrente.

ARRAY TEXT($nomeTabella;0)
ARRAY TEXT($nomeCampo;0)
ARRAY LONGINT($tipoCampo;0)
ARRAY LONGINT($lunghezzaCampo;0)
ARRAY BOOLEAN($accettaNULL;0)
ARRAY LONGINT($idTabella;0)
ARRAY LONGINT($idCampo;0)

Begin SQL
  SELECT * FROM _USER_COLUMNS
  INTO :$nomeTabella, :$nomeCampo, :$tipoCampo, :$lunghezzaCampo, :$accettaNULL, :$idTabella, :$idCampo
End SQL

// ordina per tabella e in secondo livello per idCampo
MULTI SORT ARRAY ($nomeTabella;>;$nomeCampo;$tipoCampo;$lunghezzaCampo;$accettaNULL;$idTabella;$idCampo;>)

$doc:=Create document($System folder(Desktop) +"struttura.text")
$ultimaTabella:=""
For ($i;1;Size of array($nomeTabella))
  If ($ultimaTabella#$nomeTabella{$i})
    SEND PACKET($doc;"\r"+$nomeTabella{$i}+"\t"+String($idTabella{$i})+"\r")
    $ultimaTabella:=$nomeTabella{$i}
  End if
  $tipo:=Choose($tipoCampo{$i};"-";"Boolean";"-";"Integer";"Longint";"Integer 64bits";"Real";"Float";"Date";"Time";"Alpha/Text";"-";"Picture";"-";"-";"-";"-";"-";"BLOB")
  SEND PACKET($doc;$nomeTabella{$i}+"\t"+$nomeCampo{$i}+"\t"+String($tipoCampo{$i})+"\t"+$tipo+"\t"+String($lunghezzaCampo{$i})+"\t"+String($accettaNULL{$i};"True;;False")+"\t"+String($idCampo{$i})+"\r")
End for
CLOSE DOCUMENT($doc)

In 4d è presente l'engine di visualizzazione delle immagini SVG, creabili con i comandi XML e alla fine trasformati in picture con il comando
SVG EXPORT TO PICTURE.

Ecco un esempio:

  C_PICTURE(miaPicture)
  $svg:=DOM Create XML Ref("svg";"http://www.w3.org/2000/svg")
ref:=DOM Create XML element(root;"text";\ //oggetto di tipo testo
    "font-family";"Arial";\ //con questo font
    "font-size";"26";\ //questa dimensione
    "font-weight";"bold") //questo stile
  DOM SET XML ATTRIBUTE($ref;"fill";"red") // posso aggiungere un attributo anche dopo
  DOM SET XML ATTRIBUTE($ref;"y";"1em") // imposto la posizione y
  DOM SET XML ELEMENT VALUE($ref;"Ecco un esempio")
  SVG EXPORT TO PICTURE($svg;miaPicture;Copy XML Data Source)
  DOM CLOSE XML($svg)

Per indicare il separatore fra cartelle nella v12 è stata introdotta una nuova costante che varia in funzione della piattaforma su cui è eseguito il codice, la Folder separator.

Quindi, il seguente codice avrà un risultato diverso su Mac e Windows:

$Percorso_T:=Get 4D folder(HTML Root Folder)
$Percorso_T:=$Percorso_T+"Immagini"+Folder separator+"Articoli"+Folder separator
$0:=Percorso_T

Versione del metodo che elimina gli spazi dall'inizio e dalla fine di una stringa usando il comando Match Regex e due semplici regular espressions.

C_TEXT($miaStringa;$1)
C_TEXT($0;$risultato)
C_TEXT($pattern)
C_LONGINT($inizio;$dove;$lunga)
C_BOOLEAN($trovato)
$miaStringa:=$1
$inizio:=1
$foundFlag:=False

    `pattern regex per gli spazi all'inizio
    `^ -- indica l'inizio da dove cercare
    `\s+ -- search for one or more white spaces
$pattern:="^\\s+"

$trovato:=Match regex($pattern;$miaStringa;$inizio;$dove;$lunga)
If ($trovato)
$miaStringa:=Substring($miaStringa;$lunga+1)
End if
    `pattern regex per gli spazi alla fine della stringa
    `$ -- indica la fine dove cercare
$pattern:="\\s+$"

$trovato:=Match regex($pattern;$miaStringa;$inizio;$dove;$lunga)
If ($trovato)
$miaStringa:=Substring($miaStringa;$inizio;$dove-1)
End if
$0:=$miaStringa

Ecco una versione modificata per la v11 di un metodo di esportazione dati in un file testo.

C_TEXT($testo)
C_BLOB($blob)
$pointertable:=->[LaTabella]
For ($j;1;Get last field number($pointertable))
  If (Is field number valid(Table($pointertable);$j))
    $testo:=$testo+Field name(Table($pointertable);$j)+Char(Tab )
    If ($j      $testo:=$testo+Char(Tab )
    End if
  End if
End for
$testo:=$testo+Char(Carriage return )+Char(Line feed )
TEXT TO BLOB($testo;$blob)

ALL RECORDS($pointertable->)
ARRAY LONGINT($arrRecNum;0)
SELECTION TO ARRAY($pointertable->;$arrRecNum)
For ($i;1;Size of array($arrRecNum))
  GOTO RECORD($pointertable->;$arrRecNum{$i})
  $testo:=""
  For ($j;1;Get last field number($pointertable))
    If (Is field number valid(Table($pointertable);$j))
      $pointer:=Field(Table($pointertable);$j)
      If ((Type($pointer->)=Is Alpha Field ) | ((Type($pointer->)=Is Text )))
        $testo:=$testo+$pointer->
      Else
         $testo:=$testo+String($pointer->)
      End if
      If ($j<Get last field number($pointertable))
        $testo:=$testo+Char(Tab )
      End if
    End if
  End for
  $testo:=$testo+Char(Carriage return )+Char(Line feed )
  TEXT TO BLOB($testo;$blob;UTF8 text without length ;*)
End for
BLOB TO DOCUMENT("Export.txt";$blob)

Passando come parametro una stringa in forma esadecimale al seguente metodo, questo restituisce il valore decimale relativo:

C_TEXT($CifraEsadecimale_t;$tutteLeCifre_t;$1;$NumEsadecimale_t)
C_LONGINT($0;$posizione_l)
$0:=0
$tutteLeCifre_t:="0123456789ABCDEF"
$NumEsadecimale_t:=$1
While (Length($NumEsadecimale_t)>0)
          $CifraEsadecimale_t:=Substring($NumEsadecimale_t;0;1)
          $NumEsadecimale_t:=Substring($NumEsadecimale_t;2;Length($NumEsadecimale_t))
          $0:=$0*16
          $posizione_l:=Position($CifraEsadecimale_t;$tutteLeCifre_t)-1
          $0:=$0+$posizione_l
End while

Un altro schema per l'uso delle transazioni nell'inserimento o nella modifica di un record:

Metodo del Form di inserimento


Case of
  : (Form Event=On Load)
    START TRANSACTION
    ....

  : (Form Event=On Validate)
    VALIDATE TRANSACTION
    ....

  : (Form Event=On Unload)
    If (In transaction)
      CANCEL TRANSACTION
    End if

End case

Da ricordare che il form event On Unload di default non è attivo per il form e dunque è da attivare manualmente.

Schema di base per l'utilizzo delle transazioni nella creazione o modifica di un record.

Metodo del Form di inserimento

Case of
  : (Form Event=On Load)
    START TRANSACTION
    ....

---

Pulsante Annulla

    Case of
           : (Form Event=On Clicked)
           CANCEL TRANSACTION
           CANCEL
      End case

---

Pulsante Conferma

Case of
  : (Form Event=On Clicked)
    ...
    If ($hoFattoTuttiIControlli)
      SAVE RECORD
      VALIDATE TRANSACTION
    Else
      CANCEL TRANSACTION
    End if
    CANCEL
End case

Ecco di seguito un esempio di codice per PDO_4D che consente l'uso di PHP per l'inserimento di dati, con creazione della tabella.


<?php
$dsn = '4D:host=localhost;charset=UTF-8';
$user = 'test';
$pass = 'test';

// Connection to the 4D SQL server
$db = new PDO_4D($dsn, $user, $pass);

try {
        $db->exec('CREATE TABLE test(id varCHAR(1) NOT NULL, val VARCHAR(10))');
} catch (PDOException $e) {
        die("Errore 4D : " . $e->getMessage());
}
          
$db->exec("INSERT INTO test VALUES('A', 'A')");
$db->exec("INSERT INTO test VALUES('B', 'A')");
$db->exec("INSERT INTO test VALUES('C', 'C')");

$stmt = $db->prepare('SELECT id, val from test');

$stmt->execute();
print_r($stmt->fetchAll());

unset($stmt);
unset($db);
?>




L'ouput risultante sarà:


Array
(
        [0] => Array
           (
           [ID] => A
           [0] => A
           [VAL] => B
           [1] => B
           )

        [1] => Array
           (
           [ID] => C
           [0] => C
           [VAL] => D
           [1] => D
           )

        [2] => Array
           (
           [ID] => E
           [0] => E
           [VAL] => F
           [1] => F
           )

)

Avendo la necessità di controllare se una copia di sicurezza di un disco fosse andata a buon fine, ho scritto questo metodo ricorsivo che confronta il contenuto di due differenti percorsi. È scritto con la v11SQL. Ecco il metodo ConfrontoDischi:


If (Count parameters=0)
    $percorso1:=Select folder("Percorso 1")
    If (OK=1)
        $percorso2:=Select folder("Percorso 2")
        If (OK=1)
           ARRAY TEXT(arrFile1;0)
           ARRAY TEXT(arrFile2;0)
           ConfrontoDischi (->arrFile1;$percorso1)
           ConfrontoDischi (->arrFile2;$percorso2)
           For ($i;Size of array(arrFile1);1;-1)
           arrFile1{$i}:=Delete string(arrFile1{$i};1;Length($percorso1))
           End for
           For ($i;Size of array(arrFile2);1;-1)
           arrFile2{$i}:=Delete string(arrFile2{$i};1;Length($percorso2))
           End for
           For ($i;Size of array(arrFile1);1;-1)
           $find:=Find in array(arrFile2;arrFile1{$i})
           If ($find>0)
           DELETE FROM ARRAY(arrFile1;$i)
           DELETE FROM ARRAY(arrFile2;$find)
           End if
           End for
        End if
  End if
Else
    $percorso:=$2
    ARRAY STRING(255;$arrNomiFile;0)
    DOCUMENT LIST($percorso;$arrNomiFile)
    For ($i;1;Size of array($arrNomiFile))
        APPEND TO ARRAY($1->;$percorso+$arrNomiFile{$i})
    End for
    ARRAY STRING(255;$arrNomiFile;0)
    FOLDER LIST($percorso;$arrNomiFile)
    For ($i;1;Size of array($arrNomiFile))
        ConfrontoDischi ($1;$percorso+$arrNomiFile{$i}+"\\")
    End for
End if

Ecco un metodo per esportare i dati di una tabella "Tabella" in formato solo testo, con conversione del set di caratteri in formato Windows:


$vhDocRef:=Open Document("")
If (ok=1)
  $tableptr:=->[Tabella]
  $tablenum:=Table($tableptr->)

  `prima creo la testata con i nomi dei campi
  For ($j;1;Count fields($tableptr))
    GET FIELD PROPERTIES($tablenum;$j;$fieldType;$fieldLength;$indexed;$unique;$invisible)
    $nome:=Field name($tablenum;$j)
    If ($invisible=False)
      SEND PACKET($vhDocRef;Mac to Win($nome))
      SEND PACKET($vhDocRef;Char(Tab))
    End if
  End for
  SEND PACKET($vhDocRef;Char(Carriage return))

  `seleziono tutti i record
  ALL RECORDS($tableptr->)
  ARRAY LONGINT($arrRecNum;0)
  SELECTION TO ARRAY($tableptr->;$arrRecNum)

  `esporto tutto, tranne i campi Invisibili
  For ($i;1;Size of array($arrRecNum))
    GOTO RECORD($tableptr->;$arrRecNum{$i})
    $rigadaesportare:=""
    For ($j;1;Count fields($tableptr))
      GET FIELD PROPERTIES($tablenum;$j;$fieldType;$fieldLength;$indexed;$unique;$invisible)
      If ($invisible=False)
        $pointer:=Field($tablenum;$j)
        $testodaesportare:=""
        Case of
          : (($fieldType=Is Alpha Field ) | ($fieldType=Is Text ))
           $testodaesportare:=$pointer->
           $testodaesportare:=Replace string($testodaesportare; Char(Carriage return);" ")
          : ($fieldType=Is Boolean )
           If ($pointer->)
           $testodaesportare:="Vero"
           Else
           $testodaesportare:="Falso"
           End if
          Else
           $testodaesportare:=String($pointer->)
        End case

        $rigadaesportare:=$rigadaesportare+Mac to Win($testodaesportare)+Char(Tab)
      End if
    End for
    SEND PACKET($vhDocRef;$rigadaesportare;Char(Carriage return))
  End for
  CLOSE DOCUMENT($vhDocRef)
End if

Quando creiamo in un form un termometro, 4D inserisce in automatico i valori di intervallo da 0 a 100. Ecco un metodo per utilizzare questo termometro (vTerm nel nostro caso) con qualsiasi numero (positivo o negativo, intero o decimale) all'interno di un ciclo.

$start:=0,65
$end:=0,90
$progress:=0,001
For ($i;$start;$end;$progress)
      vTerm:=100*($i-$start+$progress)/($end-$start+$progress)
      DISPLAY RECORD
End for


dove $start è il valore da cui il ciclo parte, $end è il valore di arrivo del ciclo, $progress è lo step di avanzamento.

Ecco una semplice formula con la quale calcolare il numero di giorno all'interno dell'anno:

$giornodellanno=Current date-Add to date(!00/00/00!;Year of(Current date);1;1)+1

Il comando LIST TO ARRAY non è più consigliato dalla versione v11, probabilmente nelle versioni successive potrebbe essere reso non disponibile.

Ecco un semplice codice che permette di caricare in un array il contenuto di una lista:

$lista_hl:=Load list("Posizione_fiscale")

ARRAY TEXT(Lista;Count list items($lista_hl))

For ($i; 1; Count list items($lista_hl))
  GET LIST ITEM($lista_hl; $i; $rifer_l; $nome_t)
  Lista{$i}:=$nome_t
End for

`web_urlEncode
  `prepara una stringa in modo che sia utilizzabile come parte di un Url

C_TEXT($0;$1)
C_LONGINT($car_n;$ascii_n)
C_STRING(31;$car_s;$nuovo_s)

$0:=""
$1:=Mac to ISO($1)
For ($car_n;1;Length($1))
  $car_s:=Substring($1;$car_n;1)
  $ascii_n:=Character code($car_s)

  Case of
    : ($ascii_n =32)
      $nuovo_s:="+"
    : ($ascii_n >=127)
      $nuovo_s:="%"+Substring(String($ascii_n;"&$");2)
    : (Position($car_s;":<>&%= \"")>0)
      $nuovo_s:="%"+Substring(String($ascii_n;"&$");2)
    Else
      $nuovo_s:=Char($ascii_n)
  End case
  $0:=$0+$nuovo_s
End for

Stessa cosa dell'esportazione già citata in formato test (vedi la faq Generazione automatica del file Sitemap.xml), ma scritta utilizzando i comandi Xml.

    `metodo web_sitemap.xml

C_STRING(16;vXML)
C_STRING(80;$aNSName1;$aNSName2;$aNSValue1;$aNSValue2)
C_TEXT($result)

$site:="http://www.sviluppo4d.it"

    `valori della struttura xml richiesta
$Root:="urlset"
$xpath_url:="url"
$xpath_loc:="loc"

$Namespace:="http://www.google.com/schemas/sitemap/0.84"
$aNSName1:="xmlns:xsi"
$aNSValue1:="http://www.w3.org/2001/XMLSchema-instance"
$aNSName2:="xsi:schemaLocation"
$aNSValue2:="http://www.google.com/schemas/sitemap/0.84 http://www.google.com/schemas/sitemap/0.84/sitemap.xsd"

    `creo il documento xml in memoria
vXML:=DOM Create XML Ref($Root;$Namespace;$aNSName1;$aNSValue1;$aNSName2;$aNSValue2)

    `prima elenchiamo gli indirizzi fissi

$url:=DOM Create XML element(vXML;$xpath_url)
$item:=DOM Create XML element($url;$xpath_loc)
DOM SET XML ELEMENT VALUE($item;$site)  `indirizzo base del sito

$url:=DOM Create XML element(vXML;$xpath_url)
$item:=DOM Create XML element($url;$xpath_loc)
DOM SET XML ELEMENT VALUE($item;$site+"/Users")  `un indirizzo fisso su sviluppo4d.it

    `poi costruiamo l'elenco degli indirizzi dinamici
ALL RECORDS([News])
While (Not(End selection([News])))
  $txt:=$site+"/Detail_News_Display?id="+String([News]id)+"&title="+(wb_UrlEncode ([News]Title))
  $url:=DOM Create XML element(vXML;$xpath_url)
  $item:=DOM Create XML element($url;$xpath_loc)
  DOM SET XML ELEMENT VALUE($item;$txt)
  NEXT RECORD([News])
End while

ALL RECORDS([Faq])
While (Not(End selection([Faq])))
  $txt:=$site+"/Detail_FAQ_Display?id="+String([Faq]id)+"&title="+(wb_UrlEncode ([Faq]Title))
  $url:=DOM Create XML element(vXML;$xpath_url)
  $item:=DOM Create XML element($url;$xpath_loc)
  DOM SET XML ELEMENT VALUE($item;$txt)
  NEXT RECORD([Faq])
End while

    `i tag sono chiusi automaticamente, esportiamo il documento xml
DOM EXPORT TO VAR(vXML;$result)

    `adesso lo cancelliamo dalla memoria
DOM CLOSE XML(vXML)

SEND HTML TEXT($result)

Se avete un sito dinamico, dove non tutti i link sono facilmente raggiungibili dai motori di ricerca, è utile comunicare agli stessi l'elenco degli indirizzi disponibili con un protocollo chiamato sitemap.

L'indicazione dell'esistenza della sitemap viene comunicata al motore di ricerca o tramite una loro pagina dedicata (come Google) oppure più genericamente con una riga nel file robots.txt (vedi ad esempio la faq Generazione automatica del file Robots.txt dove è descritto il file robots di Sviluppo4d.it).

Clicca qui per vedere il risultato.

`metodo web_sitemap

$eol:="\r\n"
$txt:=""

$txt:=$txt+"<?xml version='1.0' encoding='UTF-8'?>"+$eol
$txt:=$txt+"<urlset xmlns=\"http://www.google.com/schemas/sitemap/0.84\" "
$txt:=$txt+"xmlns:xsi=\"http://www.w3.org/2001/XMLSchema-instance\" "
$txt:=$txt+"xsi:schemaLocation=\"http://www.google.com/schemas/sitemap/0.84 "
$txt:=$txt+"http://www.google.com/schemas/sitemap/0.84/sitemap.xsd\">"+$eol

  `preparo la parte iniziale e finale del singolo url
$s:="<url><loc>http://www.sviluppo4d.it" `qua va il nome del sito corrente
$e:="</loc></url>"+$eol

`prima elenchiamo gli indirizzi fissi
$txt:=$txt+$s+""+$e`indirizzo base del sito
$txt:=$txt+$s+wb_xmlEncode ("/Users")+$e`indirizzo fisso su sviluppo4d.it

`poi costruiamo l'elenco degli indirizzi dinamici
ALL RECORDS([News])
While (Not(End selection([News])))
  $txt:=$txt+$s+"/Detail_News_Display?id="+String([News]id)+"&title="+ wb_xmlEncode( wb_urlEncode ([News]Title))+$e
  NEXT RECORD([News])
End while
ALL RECORDS([Faq])
While (Not(End selection([Faq])))
  $txt:=$txt+$s+"/Detail_FAQ_Display?id="+String([Faq]id)+"&title="+ wb_xmlEncode( wb_urlEncode([Faq]Title))+$e
  NEXT RECORD([Faq])
End while

  `chiudiamo il tag principale
$txt:=$txt+"</urlset>"
SEND HTML TEXT($txt)

In alcune faq precedenti (Scrivere i robots per i siti dinamici in 4d 1, Scrivere i robots per i siti dinamici in 4d 2 e Scrivere i robots per i siti dinamici in 4d 3) avevamo descritto la metodologia di scrittura del metatag nello header per ovviare al problema della sessione inclusa nei link delle pagine dinamiche.

Con la nuova versione di sviluppo4d, adesso aggiornata in v11, quella strategia non è più necessaria.

Il metodo seguente si occupa della generazione dinamica del file "robots.txt" che viene richiamato dai motori di ricerca.
In questa forma essere facilmente modificato e aggiornato anche da programma.

Clicca qui per vedere il risultato.

`metodo web_robots.txt

$eol:="\r\n"
$txt:=""
    `per tutti i motori di ricerca
$txt:=$txt+"User-Agent: *"+$eol
    `questi link non sono da seguire
$txt:=$txt+"Disallow: /Login"+$eol
$txt:=$txt+"Disallow: /User.new"+$eol
$txt:=$txt+"Disallow: /Comment.add"+$eol
$txt:=$txt+"Disallow: /Detail_FAQ_New"+$eol
    `mentre tutto il resto si
$txt:=$txt+"Allow: /"+$eol
    `e segnalo l'indirizzo della Sitemap
$txt:=$txt+"Sitemap: http://www.sviluppo4d.it/sitemap.xml"+$eol
SEND HTML TEXT($txt)

Un po' di tempo fa avevo letto un discussione sul calcolo del numero della settimana; mi è capitato di leggere la definizione dell'inizio anno in base alla quale l'anno inizia dal Lunedì della settimana che contiene il 4 gennaio ed ecco qui l'algoritmo corretto



xData:=Date(Request("Data";String(Current date)))

    ` ----------------------------------------------------
    ` User name (OS): llarosa
    ` Date and time: 12/01/09, 13:09:35
    ` ----------------------------------------------------
    ` Method: Calcolo numero settimana
    ` Description Ritorna la settimana dell'anno usando ISO 8601 standard
    ` ( l'anno parte dal Lunedi della settimana che contiene il 4 Gennaio)
    `
    ` Parameters
    ` ----------------------------------------------------

  ` calcolo il 4 di gennaio che giorno è -2 perchè la day number conta come primo giorno la domenica
Jan04DOW:=Day number(Date("04-01-"+String(Year of(xData))))-2
` avendo fatto -2 la domenica diventa -1 e la riporto a 6
Jan04DOW:=(Num(Jan04DOW=-1)*6)+(Num(Jan04DOW#-1)*Jan04DOW)
` calcolo la data del primo lunedi dell'anno
FirstMonday:=Date("04-01-"+String(Year of(xData)))-Jan04DOW
` se la data è inferiore al primo lunedi dell'anno allora appartengono all'ultima settimana dell'anno
` prima quindi calcolo il primo lunedi dell'anno precedente
If (xData<FirstMonday)
` come già descritto ma riferito all'anno precedente
  Jan04DOW:=Day number(Date("04-01-"+String(Year of(xData)-1)))-2
  Jan04DOW:=(Num(Jan04DOW=-1)*6)+(Num(Jan04DOW#-1)*Jan04DOW)
  FirstMonday:=Date("04-01-"+String(Year of(xData)-1))-Jan04DOW
End if
xWeek:=(Int((xData-FirstMonday)/7))+1 ` calcolo della settimana
End if

ALERT(String(xWeek))

  `Nexus srl 12-5-04
    `toglie gli spazi all'inizio e alla fine
C_STRING(255;$str_s)
C_STRING(1;$spc_s)
C_LONGINT($first_l;$last_l)
$str_s:=$1
$spc_s:=Char(32)
If ($str_s#"")
  $first_l:=1
  $last_l:=Length($str_s)
  While (($first_l<$last_l) & (Substring($str_s;$first_l;1)=$spc_s))
    $first_l:=$first_l+1
  End while
  While (($last_l>=$first_l) & (Substring($str_s;$last_l;1)=$spc_s))
    $last_l:=$last_l-1
  End while
  $str_s:=Substring($str_s;$first_l;$last_l-$first_l+1)
End if
$0:=$str_s

Nota: ho dovuto sostituire l'indicizzazione del carattere $str_s[[$last_l]] con il più solido Substring, perché anche se è corretto formalmente nel caso in cui arrivasse a zero l'ultimo carattere (ad esempio, $1 = " ") la condizione del while dà un errore sulla versione v11.

In certe situazioni può accadere che l'utente chiuda spesso il programma, ad esempio nelle installazioni monoutenza.

Alla prima ricerca 4D deve caricare gli indici in cache e quindi la prima ricerca puà risultare lenta in modo anomalo all'utente.

Un trucco è caricare gli indici all'avvio del programma in un processo separato: si può lanciare ad esempio una query sui campi più usati.

Se c'è abbastanza cache e il database non è molto grande eseguendo il presente metodo si caricano tutti gli indici all'avvio.

`Metodo CaricaIndici

READ ONLY(*)
MESSAGES OFF
C_LONGINT($fieldType;$fieldLen)
C_BOOLEAN($indexed)
C_REAL($valoreNum)
C_DATE($valoreData)
C_TIME($valoreOra)
C_TEXT($valoreSt)
C_BOOLEAN($valoreBool)
For ($i;1;Count tables)
  For ($j;1;Count fields($i))
    GET FIELD PROPERTIES($i;$j;$fieldType;$fieldLen;$indexed)
    If ($indexed)
      $tabellaptr:=Table($i)
      $campoptr:=Field($i;$j)
      ALL RECORDS($tabellaptr->)
      FIRST RECORD($tabellaptr->)
      Case of
        : (($fieldType=Is Alpha Field ) | ($fieldType=Is Text ))
          $valoreSt:=$campoptr->
          QUERY($tabellaptr->;$campoptr->=$valoreSt)
        : (($fieldType=Is Real ) | ($fieldType=Is LongInt ) | ($fieldType=Is Integer ))
          $valoreNum:=$campoptr->
          QUERY($tabellaptr->;$campoptr->=$valoreNum)
        : ($fieldType=Is Date )
          $valoreData:=$campoptr->
          QUERY($tabellaptr->;$campoptr->=$valoreData)
        : ($fieldType=Is Time )
          $valoreOra:=$campoptr->
          QUERY($tabellaptr->;$campoptr->=$valoreOra)
        : ($fieldType=Is Boolean )
          $valoreBool:=$campoptr->
          QUERY($tabellaptr->;$campoptr->=$valoreBool)
        End case
        UNLOAD RECORD($tabellaptr->)
    End if
  End for
End for
MESSAGES ON

Prima di tutto complimenti per il sito, non solo perché è davvero bello ma perché si vede che c'è chi ci lavora, quindi complimenti a chi lo fa.

Mando un frammento di codice che ritengo interessante anche se forse non hamolte occasioni d'impiego; è un method che converte un valore numerico nella corrispondente stringa descrittiva in lettere, esempio 8519 =
"ottomilacinquecentodiciannove".

Non ho trovato nulla di già fatto per 4D (in italiano). La conversione avviene nel formato usuale per valori in euro con decimali, come si usa per gli assegni, per esempio "trecentoventi/23centesimi"; è modificabile e si
puo facilmente omettere o modificare la parte decimale.
E' abbastanza compatto, contrariamente a quanto io stesso avevo supposto accingendomi a scriverlo.

Uso: passare un valore di tipo reale e torna un tipo testo. Accetta valori
da 1 a 999.999.999, genera un messaggio di errore se si passa un valore fuori range.



C_REAL($1;$valore)
C_TEXT($0;$decimale;$stringa)

ARRAY INTEGER($base;8)
ARRAY TEXT($descrizione;3)
C_INTEGER($X;$gruppo;$valoreDecine)

ARRAY TEXT($nome_unità;9)
$nome_unità{0}:=""
$nome_unità{1}:="uno"
$nome_unità{2}:="due"
$nome_unità{3}:="tre"
$nome_unità{4}:="quattro"
$nome_unità{5}:="cinque"
$nome_unità{6}:="sei"
$nome_unità{7}:="sette"
$nome_unità{8}:="otto"
$nome_unità{9}:="nove"

ARRAY TEXT($nome_10_20;9)
$nome_10_20{0}:=""
$nome_10_20{1}:="undici"
$nome_10_20{2}:="dodici"
$nome_10_20{3}:="tredici"
$nome_10_20{4}:="quattordici"
$nome_10_20{5}:="quindici"
$nome_10_20{6}:="sedici"
$nome_10_20{7}:="diciassette"
$nome_10_20{8}:="diciotto"
$nome_10_20{9}:="diciannove"

ARRAY TEXT($nome_decine;10)
$nome_decine{0}:=""
$nome_decine{1}:="dieci"
$nome_decine{2}:="venti"
$nome_decine{3}:="trenta"
$nome_decine{4}:="quaranta"
$nome_decine{5}:="cinquanta"
$nome_decine{6}:="sessanta"
$nome_decine{7}:="settanta"
$nome_decine{8}:="ottanta"
$nome_decine{9}:="novanta"
$nome_decine{10}:="cento"

$decimale:=Replace string(String(Dec($1));"0,";"")
$decimale:=$decimale+("0"*Num(Length($decimale)=1))
If ($decimale="00") `è uno zero non lettera o
  $decimale:="zero"
End if
$valore:=Int($1)

If ($valore=0) | ($valore>=(10^9)) ` valori accettati per la parte intera da 1 a 999.999.999
  $0:="### ERRORE valore fuori range"
Else
  For ($X;8;0;-1) ` calcola le basi per gli esponenti da 0 a 8 - esempio 825 = 8*(10^2) + 2*(10^1) + 5*(10^0)
    $base{$X}:=Int($valore/(10^$X))
    $valore:=$valore-($base{$X}*(10^$X))
  End for
  $gruppo:=3 `elabora separatamente milioni, migliaia e unità, nell'ordine (si potrebbe anche procedere per ordine inverso, non cambia)
  For ($X;8;0;-3)
    If ($base{$X}=1)
      $descrizione{$gruppo}:="cento"
    Else
      $descrizione{$gruppo}:=$nome_unità{$base{$X}}+("cento"*Num($base{$X}>0))
    End if
    $valoreDecine:=$base{$X-1}*10+$base{$X-2}
    If ($valoreDecine=1) & ($base{$X}=0)
      $descrizione{$gruppo}:=$descrizione{$gruppo}+("unmilione"*Num($gruppo=3))+("mille"*Num($gruppo=2))+("uno"*Num($gruppo=1))
    Else
      If ($valoreDecine>10) & ($valoreDecine<20) ` se >10 e <20 usa i nomi unidici, dodici, ecc
        $descrizione{$gruppo}:=$descrizione{$gruppo}+$nome_10_20{($valoreDecine-10)*Num(($base{$X-1})>0)}
      Else `altrimenti usa i nomi delle decine + i nomi delle unità
        If ($base{$X-2}=1) | ($base{$X-2}=8) ` se nome unità inizia per vocale omette l'ultima vocale del nome delle decine (ventuno e non ventiuno)
          $stringa:=Substring($nome_decine{$base{$X-1}};1;Length($nome_decine{$base{$X-1}})-1)
        Else
          $stringa:=$nome_decine{$base{$X-1}}
        End if
        $descrizione{$gruppo}:=$descrizione{$gruppo}+$stringa+$nome_unità{$base{$X-2}}
      End if
      $descrizione{$gruppo}:=$descrizione{$gruppo}+(("milioni"*Num($gruppo=3))*Num($descrizione{$gruppo}#""))
      $descrizione{$gruppo}:=$descrizione{$gruppo}+(("mila"*Num($gruppo=2)*Num($descrizione{$gruppo}#"")))
    End if
    $gruppo:=$gruppo-1 `elabora il gruppo successivo
  End for
  $0:=$descrizione{3}+$descrizione{2}+$descrizione{1}+" e "+$decimale+" centesimi" `concatena i nomi dei 3 gruppi: milioni, migliaia, unità + i decimali
End if

Mi è capitato a volte che SET CURRENT PRINTER non mi cambiasse la stampante, soprattutto se la stampante era una stampante di rete. Per autorisolvermi il problema ho adottato alcune strategie.
Il primo tentativo, poco fruttuoso in realtà, è stato quello di pingare l'ip della stampante o del print server associato, usando:

C_LONGINT($alive)
For ($i;1;3)
      NET_Ping ([Stampanti]IP_da_controllare;"";$alive;1)
      If ($alive=1)
           $i:=5
      End if
End for

ma a volte la stampante non veniva variata ugualmente.
Allora sono passato all'approccio "controllo se la stampante è cambiata", cioè:

Repeat
      SET CURRENT PRINTER([Stampanti]Stampante)
      $StampanteCorrente:=Get current printer
Until ($StampanteCorrente=[Stampanti]Stampante)

Avendo poi visto che in massimo due/tre passaggi la stampante veniva settata, per evitare un controllo troppo bloccante ho deciso di usare:

For ($i;1;5)
      SET CURRENT PRINTER([Stampanti]Stampante)
End for


Così, se la stampante non viene settata per un qualsiasi motivo, stamperebbe comunque sulla stampante di default, ma questo errore non si è più verificato.

UDP (User Datagram Protocol) è un protocollo di comunicazione di facile implementazione più snello di TCP (per l'header TCP usa 20 byte, UDP 8) ma non altrettanto affidabile. Se da un lato infatti permette comunicazioni veloci, dall'altra non viene fatto alcun controllo d'errore o riparazione di dati non ricevuti.

La v11 SQL mette a disposizione una serie di comandi che implementano la comunicazione via UDP. Quello che segue è un esempio che usa i comandi UDP per ottenere l'elenco dei server 4D presenti in una rete locale.



ARRAY STRING (255;asHost;0)
ARRAY STRING (32;asMachineName;0)
ARRAY STRING (32;asService;0)
ARRAY STRING (32;asDBName;0)
C_BLOB ($Blob)

$indirizzo_t:="255.255.255.255"
$Porta_t:=19813
$posizione_l:=32
SET BLOB SIZE($Blob;96;0)
TEXT TO BLOB("4D Server";$Blob;Mac text without length;$posizione_l)
$Err:=UDP_New(0;$udpID)
$Err:=UDP_SendBLOBTo($udpID;$indirizzo_t;$Porta_t;$Blob)
$Secondi_l:=2
$Timeout_l:=Milliseconds+($Secondi_l*1000)
Repeat
  DELAY PROCESS(Current process;6) `... espresso in ticks
  SET BLOB SIZE($Blob;0;0)
  $guardaIndirizzo_t:=$indirizzo_t
  $Err:=UDP_ReceiveBLOBFrom($udpID;$guardaIndirizzo_t;$Porta_t;$Blob)
  If (BLOB size($Blob)>0)
    $posizione_l:=0
    $Host_t:=BLOB to text($Blob;Mac C string;$posizione_l;32)
    $posizione_l:=32
    $Service_t:=BLOB to text($Blob;Mac C string;$posizione_l;32)
    $posizione_l:=64
    $DBName_t:=BLOB to text($Blob;Mac C string;$posizione_l;32)
    $Pos:=Find in array(asMachineName;$Host_t)
    If ($Pos>0)
      APPEND TO ARRAY(asHost;$guardaIndirizzo_t)
      APPEND TO ARRAY(asMachineName;$Host_t)
      APPEND TO ARRAY(asService;$Service_t)
      APPEND TO ARRAY(asDBName;$DBName_t)
    End if
  End if
Until ((Milliseconds>$Timeout_l) | ($Err#0))
$Err:=UDP_Delete($udpID)

L'algoritmo MD5 (Message Digest 5) è una funzione di hash usata per la criptazione dei dati

Il comando del 4D Pack AP Get file MD5 digest permette di ottenere il digest MD5 per un certo file.

L'uso tipico del comando potrebbe essere il seguente:

C_TEXT($thedoc)
C_TEXT(<>digest)
C_LONGINT($resfork)
$resfork:=0 `su Mac: 0 specifica su data fork, 1 su resource fork
$thedoc:=Select document
$error:=AP Get file MD5 digest($thedoc;<>digest;§resfork)

Dalla versione v11 è ora possibile scegliere fra diversi tipi di indici:

Automatic : il sistema seleziona quello più adatto

B-tree : in pratica i classici indici ad albero da sempre usati e adatti più o meno a tutti i casi generali

Cluster b-tree : è molto efficiente per i camp che non hanno molte varianti, come possono esserlo i booleani o il campo Sesso

Keyword index : è un secondo indice che è possibile aggiungere ai campi alfabetici e testo; velocizza le Ricerche per parola chiave

Composite: serve ad ottimizzare ricerche che vanno fatte spesso su più campi, come ad esempio Nome e Cognome oppure Prefisso e Numero di Telefono

Ecco la lista dei requisiti minimi per la v11. La cosa che risalta maggiormante è la necessità di uno schermo con risoluzione minima 1280x1024 (per lo sviluppo almeno, visto che il pulsante "Preferences" del Designer "deborda" in uno schermo 1024x768).

Ecco il dettaglio:

Windows
Pentium III
Windows Vista
Windows XP
512 MB RAM (1 GB raccomandato)
Risoluzione dello schermo 1280x1024

Mac OS
Mac Intel ® or PowerPC (G5 raccomandato)
Mac OS 10.4.5 o successivo
512 MB RAM (1 GB raccomandato)
Risoluzione dello schermo 1280x1024

Inn SQL si possono risolvere alcune cose che in 4D sono lunghe e tediose, tipo cercare quanti duplicati ci sono in una tabella di record anagrafici.

Ecco un esempio di ricerca in Sql:

ARRAY LONGINT(arrayQuanti;0)
ARRAY TEXT(arrayRagSoc;0)
ARRAY TEXT(arrCitta;0)
ARRAY TEXT(arrIndirizzo;0)

Begin SQL
        SELECT count(RagioneSociale), RagioneSociale, Citta, Indirizzo
        FROM Anagrafica
        GROUP BY RagioneSociale, Citta, Indirizzo
        HAVING count(RagioneSociale)>1
        INTO :arrayQuanti, :arrayRagSoc, :arrCitta, :arrIndirizzo
End SQL

La select cercherà nella tabella [Anagrafica] i record che abbiano gli stessi dati nei campi [Anagrafica]RagioneSociale, [Anagrafica]Citta, [Anagrafica]Indirizzo.

Poi produrrà 4 colonne di dati e cioè il conteggio e i tre campi con i dati unici.

Il risultato andrà negli array elencati in coda nello stesso ordine dei campi della prima riga.

Per passare un valore dinamico fra il linguaggio di 4d e l'SQL, si possono indicare i nomi delle variabili o in due coppie di segni minore/maggiore o prefissarli con un due punti, ad esempio:

<>
:miaListBox

La notazione con i due punti rappresenta un parametro per una Parameterized Query.
La notazione con i segni di maggiore/minore viene chiamata Direct Association.

Ecco due esempi:
`Mostra il risultato di una select in una List Box, miaListBox.
Begin SQL
      SELECT * FROM Angarafica INTO <>
End SQL

`Inserisci un determinato valore in una chiamata
sNome:="Mario"
Begin SQL
      SELECT * FROM Anagrafica WHERE Nome = :sNome
End SQL

L'insider non c'è più come applicativo a parte e le sue funzioni sono ora incorporate.. ad esempio:

• i componenti si installano trascinandoli nella cartella Components
  
• il find nel database oltre a sembrare più veloce ha un sacco di opzioni in più
  (ad esempio puoi cercare fra gli oggetti modificati dopo una certa data!)
  
• se cerchi solo fra i metodi il risultato appare su due colonne con i chiamanti e i chiamati
  
• anche nell'explorer il menu contestuale su un metodo ti permette di mostrare chi lo chiama
  
• è possibile spostare gli oggetti fra due database, aprendo due 4d Developer: durante la copia 4d porta tutti gli oggetti relativi e in una finestra di scelta permette di decidere cosa fare di eventuali duplicati
  

In 4D v11, i campi testo, BLOB e immagini che possono contenere fino a 2gb di dati
sono registrati fuori dal record stesso: questo aumenta la velocità del database, specialmente durante le ricerche: quando 4d accede al record non carica in memoria tutti i dati contenuti in questi campi. Sono invece caricati automaticamente quando il record cercato viene trovato.

L'operazione non richiede nessuna modifica al codice esistente, se non che rende inutile eventuale codice impostato per registrare questi campi in una tabella separata: questa tecnica funziona ancora, ma con la v11 non serve più.

Durante lo sviluppo di una form, esiste una nuova scorciatoia per avere delle informazioni veloci (nome, coordinate, etc) su un oggetto qualsiasi.

Per vederle basta tenere premuto la combinazione di tasti Ctrl+Shift (su Windows) o Command+Shift (su Mac) puntando sull'oggetto con il mouse.

Le Listbox sono degli oggetti che permettono di mostrare nelle maschere griglie di dati.

Dalla versione v11 le ListBox possono essere collegate (anche da linguaggio di programmazione) alla selezione corrente di una tabella o ad una named selection (in pratica una selezione salvata con un suo nome).

Quando è collegata alla selezione corrente una listbox editabile aggiorna contemporaneamente i dati e riceve automaticamente gli aggiornamenti.

Un'altra cosa interessante la possibilità di riempire al volo una listbox con il risultato di una select:

Begin SQL
    select * from Anagrafica into :Listbox
End SQL

Questo codice riempirà automaticamente la listbox con i dati dalla tabella Anagrafica eventualmente creando le colonne mancanti o rendendo invisibile le colonne di troppo.

E' disponibile un nuovo comando che effettua la ricerca di una "parola" intera in un campo testo.

Nella finestra delle Query l'operatore si chiama “contains keyword”, mentre nel linguaggio (nei comandi QUERY) si può usare il carattere % .

La funzione trova solo singole parole che nel testo siano separate dalle altre da spazi o punti, virgole, etc.

La ricerca è indifferente alle maiuscole e ai caratteri diacritici, tipo l'accento sulle vocali) e rispetta la @ come wildcard.

Se avete una variabile immagine in un form, potete zoomarla (ingrandirla o rimpicciolirla) moltiplicando la variabile per un numero maggiore o minore di 1.

Ad esempio:

immagineNelForm:= immagineNelForm * 1.1 `per ingrandirla del 10%

immagineNelForm:= immagineNelForm * 0.9 `per rimpicciolirla del 10%

Ecco un piccolo metodo per contare il numero di parole presenti in un testo passato come parametro. In maniera banale si contano gli spazi non consecutivi, inserendo inoltre le eccezioni che servono (tipo presenza di trattini).

C_LONGINT($numeroparole;$posizione)
C_TEXT($1)

$numeroparole:=0
If (Length($1)>0)
      For ($posizione;1;(Length($1)-1))
          If (($1[[$posizione]]=Char(32)) & ($1[[$posizione+1]]#Char(32)) & ($1[[$posizione+1]]#"-"))
           $numeroparole:=$numeroparole+1
          End if
      End for
      $numeroparole:=$numeroparole+1
End if
$0:=$numeroparole

Per ottenere un unico documento dalla stampa di un record, magari anche multipagina, ed un allegato (utile per invio di Fax) inserire nel metodo del Form

If (b_DaEseguire)
    Print form([TABLE];"Allegato_A")
    PAGE BREAK
    b_DaEseguire:=False
End if

mentre il metodo chiamante sara' quello standard per stampe

OUTPUT FORM([TABLE];"Form")
b_DaEseguire:=True
PRINT RECORD([TABLE])

verificare che sia abilitato il selettore 'On Header' del Form del Record
(purtroppo viene stampato per primo l'allegato)

Se avete già una gestione delle pagine Web sul vostro applicativo 4D, quando installate Ajax Framework della 4d Web Pack 2.0, oltre alle istruzioni indicate nella documentazione, modificate così il metodo generale della On Web Connection:

` On Web Connection

C_TEXT($1;$2;$3;$4;$5;$6)
If ($1="/DAX/@")
  DAX_Dev_OnWebConn($1;$2;$3;$4;$5;$6)
Else

` qui va il codice preesistente

End if

Il seguente metodo salva in un file di testo l'elenco dei file contenuti in una cartella.

$folder:=Select folder("Scegli la cartella")
If (OK=1)
      ARRAY TEXT($arrelenco;0)
      DOCUMENT LIST($folder;$arrelenco)
      $testo:=""
      SORT ARRAY($arrelenco;>)
      For ($i;1;Size of array($arrelenco))
           $testo:=$testo+$arrelenco{$i}+Char(Carriage return )+Char(Line feed )
           C_BLOB($blob)
           TEXT TO BLOB($testo;$blob;3)
           BLOB TO DOCUMENT("elenco.txt";$blob)
      End for
End if

Quando carichi (con il load record o il next record, ad esempio) un record in modalità scrittura, 4d lo blocca automaticamente. Il blocco è di un solo record per tabella in ogni processo.

Se vuoi bloccare più record, puoi usare il comando PUSH RECORD.

Questo comando mette il record corrente in uno stack, per poi recuperarlo con un successivo POP RECORD: viene usato normalmente per tenere da parte un record mentre si fanno delle altre query sulla stessa tabella.

Ma la cosa meno nota è che si possono "pushare" anche più record uno dopo l'altro e restano tutti bloccati in scrittura finché non vengono "poppati". I record vengono ritrovati nella modalità LIFO, l'ultimo inserito è il primo ritrovato.

E' possibile, direttamente da 4th Dimension, effettuare una chiamata con Skype utilizzando molto semplicemente la sintassi:

OPEN WEB URL("Skype:Nome_Utente?Call";*)

Si possono incontrare problemi di prestazioni di 4D su Windows quando si deve svuotare un array (solitamente per portarne la dimensione a 0).
Ad esempio, il seguente metodo verrà eseguito per un tempo NON ragionevole, su una macchina Windows:

`=====
C_LONGINT($size;$i;$start;$end)
$size:=100000
$start:=Milliseconds
ARRAY TEXT($text;$size)
ARRAY TEXT($text2;$size)
For ($i;1;$size)
    $text{$i}:="blabla"+String($i)
    $text2{$i}:="blabla"+String($i)
End for
ARRAY TEXT($text;0)
ARRAY TEXT($text2;0)
$end:=Milliseconds
`=====


Però, se svuotiamo il contenuto degli elementi degli array prima di portarne la dimensione a 0, il metodo diventerà VELOCISSIMO:

`=====
C_LONGINT($size;$i;$start;$end)
$size:=100000
$start:=Milliseconds
ARRAY TEXT($text;$size)
ARRAY TEXT($text2;$size)
For ($i;1;$size)
    $text{$i}:="blabla"+String($i)
    $text2{$i}:="blabla"+String($i)
End for
For ($i;1;$size)
    $text{$i}:=""
    $text2{$i}:=""
End for
ARRAY TEXT($text;0)
ARRAY TEXT($text2;0)
$end:=Milliseconds
`=====

E ciò semplicemente perché lo svuotamento è nettamente più rapito su array di elementi "vuoti".

Il seguente codice riempie in maniera ricorsiva l'array attribute2DArr con tutti gli attributi e i valori presenti in un file XML. Volendo fare il parse di un XML risulta molto utile. Il metodo riceve come parametro il riferimento ottenuto tramite il comando DOM Parse XML source e la dichiarazione dell'array
ARRAY TEXT(attribute2DArr;0;0)
deve essere fatta al di fuori del metodo.


C_TEXT($elementName;$elementValue)
C_TEXT($attributeName;$attributeValue)
$elementRef:=$1

    `prendi le info sull'elemento ------------------------
DOM GET XML ELEMENT NAME($elementRef;$elementName)
DOM GET XML ELEMENT VALUE($elementRef;$elementValue)
$elementID:=0

    `prendi le info sull'attributo----------------------
$numAttributes:=DOM Count XML attributes($1)

If ($numAttributes#0) `lo metto nell'array
      $sizeOfArray:=Size of array(attribute2DArr)+1  
      INSERT ELEMENT(attribute2DArr;$sizeOfArray)
      For ($i;1;$numAttributes)
           DOM GET XML ATTRIBUTE BY INDEX($1;$i;$attributeName;$attributeValue)
           attributeTxt:=$attributeName+": "+$attributeValue
           APPEND TO ARRAY(attribute2DArr{$sizeOfArray};attributeTxt)
      End for
End if

    `percorro l'albero ricorsivamente-------------------
$elementRef:=DOM Get first child XML element($elementRef)
If (OK=1)  `esiste un figlio
      While (OK=1)
           Get_xmlParseTree ($elementRef)
           $elementRef:=DOM Get Next sibling XML element($elementRef)
      End while
End if

A questo indirizzo trovate la faq relativa al comando Application type. Ecco un esempio di utilizzo.
Supponiamo di voler distinguere ottenere la data corrente dal server (se siamo in modalità client/server) o dal computer locale. il codice da eseguire sarà:

C_DATE($0)
C_DATE($currentDate)

If (Application type=4D Client )
      $currentDate:=Current date(*)
Else `se siamo sul server o in monoutenza
        $currentDate:=Current date
End if

$0:=$currentDate

Con questo articolo voglio estendere quando gia' descritto nell'articolo di
Serena Zanfini sull'integrazione di 4D ed il linguaggio PHP (il link
dell'articolo e'
http://www.sviluppo4d.it/4DCGI/Detail_FAQ_Display?ID=190 ).

Tipicamente, in molti progetti di siti web, si utilizzano pagine dinamiche PHP per
interfacciarsi ad un database SQL, tipicamente MySQL (basti pensare ai numerosi
pacchetti di installazione di Apache+PHP+MySQL che ci sono in rete: xampp, easyphp, ...).

Tipicamente il linguaggio PHP fornisce i costrutti per interfacciarsi a questi
database, ma questo non accade per 4D. E non esiste neache una soluzione del tipo
"4D Open for PHP".

E possibile pero' accedere ai dati di 4D pubblicando alcune procedure come Web Services,
tramite SOAP (Simple Object Access Protocol, i dettagli li trovate all'indirizzo
www.w3.org/TR/soap/).

Ovviamente non e' necessario che WebServer e 4D siano installati sulla stessa
macchina, descrivero' in seguito tale dettaglio.

Innanzitutto dovete avere una macchina con Apache e PHP installati: se siete in
ambiente Mac OS X potete usare anche l'installazione fornita con il sistema altrimenti
potete utilizzare i pacchetti forniti da Server Logistics (http://www.serverlogistics.com/)
che sono semplicissimi da installare. Se invece il vostro WebServer deve
essere installato in ambiente Windows, potete usare Xampp (http://www.apachefriends.org/en/xampp.html)
o EasyPHP (http://easyphp.org).

A questo punto potete procedere alla configurazione del database 4D.

Quello che vi serve e' innanzitutto la licenza Web di 4D oppure la licenza per il
solo modulo Web Services.

Per quanto riguarda la configurazione del Web Server, vi consiglio di impostare il
numero della porta attraverso la finestra delle Preferenze. Personalmente ho impostato
tale porta al numero 5200. Mettete anche la spunta su "Publish Database as Startup", in modo
da non dover avviare il Web Server tutte le volte a mano. Per quanto riguarda i
Web Services, mettete la spunta su "Allow Web Services Requests".

Per creare un nuovo Web Service e' sufficiente creare un nuovo metodo, sia esso
wsTest. Per questo metodo vanno impostate le proprieta' "Offered as a Web Service" e
"Published in WDSL". Ora possiamo scrivere un normale metodo che accetta argomenti e
restituisce un valore, poi va' inserito del codice opportuno in modo che tali parametri
siano accettati. Sia wsTest il nodi di questo metodo.

Prima di descrivere quali modifiche fare al metodo rispetto alla forma standard,
descriviamo il codice PHP per interagire con tale metodo o Web Service.

E' necessaria un libreria PHP che si chiama NuSOAP, liberamente scaricabile
dal sito web http://dietrich.ganx4.com/nusoap/ dove e' disponibile anche la documentazione.
Il file della libreria, nusoap.php, va incluso nel codice della pagina PHP che
fa' la chiamata al server 4D. Personalmente ho copiato questo file all'indirizzo
/include del Web Server, in modo da non aver problemi con i percorsi per
l'inclusione: infatti per includere la libreria utilizzo il comando:

require_once($_SERVER['DOCUMENT_ROOT'].'/include/nusoap.php');

Inoltre, come avevo accennato in precedenza, per essere indipendenti dall'host dove
risiede il server 4D, ho definito un file INI, che ho chiamato config.ini cosi' strutturato:

[Principale]
4DServerIP = 192.168.10.5
4DServerPort = 5200
WebServerIP = 192.168.10.5

Questi parametri vengono letti tramite la funzione parse_ini_file di PHP, che trasforma
questo file in un array associativo.

Siamo ora in grado di comprendere il seguente codice PHP:

$config = parse_ini_file("config/config.ini");
// faccio la chiamata al server 4D per avere il controllo dell'username
// e della password
require_once($_SERVER['DOCUMENT_ROOT'].'/include/nusoap.php');
$sc = "http://".$config['4DServerIP'].":";
$sc.=$config['4DServerPort']."/4DSOAP";
$soapclient = new soapclient($sc);
$parameters = array('username'=>'mionome', 'password'=>'miapassword');
$ret = $soapclient->call('wsTest',$parameters);
unset($soapclient);
If (!$ret) {
print "Errore SOAP:" . $soapclient->getError() . '\n

';
exit;
} Else {
print "Funziona!";
}

Come e' evidente in questa piccola porzione di codice, e' stato definito una array
associativo i cui campi sono 'username' e 'password', la chiamata e' effettuata
tramite la call. Il fatto che il PHP sia flessibile con i tipi ci avvantaggia un po'
per quanto riguarda la variabile del risultato, l'unica cosa che dobbiamo controllare
e' che non ci sia stato un errore nella chiamata del Web Service.

Il metodo wsTest che viene eseguito e' il seguente:

    `
    `Autenticazione
    `
    `Parametri:
    `$0 TEXT- risultato
    `$1 TEXT- username
    `$2 TEXT- password
C_TEXT($0)
C_TEXT($1)
C_TEXT($2)
SOAP DECLARATION($0;Is Text ;SOAP Output )
SOAP DECLARATION($1;Is Text ;SOAP Input ;"username")
SOAP DECLARATION($2;Is Text ;SOAP Input ;"password")
ALL RECORDS([Utenti])
QUERY([Utenti];[Utenti]UserID=$1)
If (Records in selection([Utenti]) # 1)
$0:="Utente o password errata."
Else
FIRST RECORD([Utenti])
If ([Utenti]Password = $2)
$0:="Ok"
Else
$0:="Utente o password errata."
End if
End if


E' facile notare che la dichiarazione dei tipi dei parametri precede quella
della dichiarazione SOAP, in modo da poter usare questa funzione non necessariamente
attraverso una chiamata SOAP.
I tipi di dato della dichiarazione SOAP possibili sono (il testo che va' inserito nella
dichiarazione):

Is BLOB
Is Boolean
Is Integer
Is LongInt
Is Real
Boolean array
String array
Date array
Integer array
LongInt array
Real array
Text array
Is Text
Is Date
Is Time
Is String Var

L'ultimo campo della dichiarazione SOAP deve essere il nome della variabile
nell'array associativo definito in PHP. Se decidiamo di ottenere piu' di una
variabile in uscita, nel codice PHP bastera' aggiungere varie dichiarazioni di SOAP Output,
ed il risultato in PHP sara' un array associativo (che prende i nomi delle variabili
cosi' come definiti in 4D).

Un ultima nota di questo articolo va' fatta per quanto riguarda il timeout della
chiamata SOAP. Infatti, se utilizzate il debug per testare il vostro codice,
puo' darsi che durante l'esecuzione passo passo del codice 4D vada in timeout la
chiamata SOAP (tipicamente dopo 60 sencodi, ma non sono sicuro).
E' possibile pero' impostare questo tempo di timeout, in modo da provare il nostro
codice "in tranquillita'", tramite il comando 4D:

SET WEB SERVICE OPTION(Web Service HTTP Timeout;120)

Vi consiglio di inserire questo codice all'avvio dell'applicazione 4D e rimuoverlo
poi prima della compilazione.

Ecco un esempio con i comandi necessari ad eeseguire una query via ODBC utilizzando i comandi integrati in 4D 2004.

$testoquery:="SELECT ....... FROM ....... WHERE ........"
ODBC LOGIN("DatabaseAccess";"";"")
ODBC EXECUTE($testoquery;array1;array2;......)
ODBC LOAD RECORD(ODBC All Records )
ODBC LOGOUT

` ======================================
    ` CHECK HTML TAGS di Roberto Vergani (05-2006)
    ` ======================================

C_TEXT($info;$sourceText;$resultText;$tag)
C_INTEGER($X;$J;$k;$n;$size;$vLineNumber;$startLine;$offset)
C_STRING(2;$char)
C_BOOLEAN($notFound)

ARRAY TEXT($vtErrorText;0)

$size:=Test clipboard("TEXT")

Case of
  : ($size<=0)
    ALERT("Gli appunti non contengono testo, elaborazione interrotta.")
  : ($size>31000)
    ALERT("Il contenuto degli appunti supera i 31K, elaborazione interrotta.")
  Else
    $info:="Questa procedura controlla la parità dei tags HTML"+Char(13)
    $info:=$info+"Procedi dopo avere copiato in appunti il codice sorgente."
    CONFIRM($info;"Procedi";"Annulla")
    
    If (OK=1)
      
          ` ECCEZIONI: questi TAG usualmente non hanno chiusura, SONO IGNORATI
          ` aggiungi o togli quello che vuoi, inserisci senza i delimitatori < >
          ` tutti i tags che iniziano con       
      ARRAY TEXT($vtExceptions;13)
      $vtExceptions{1}:="img"
      $vtExceptions{2}:="br"
      $vtExceptions{3}:="br/"
      $vtExceptions{4}:="input"
      $vtExceptions{5}:="link"
      $vtExceptions{6}:="meta"
      $vtExceptions{7}:="?xml"
      $vtExceptions{8}:="area"
      $vtExceptions{9}:="param"
      $vtExceptions{10}:="base"
      $vtExceptions{11}:="hr"
      $vtExceptions{12}:="frame"
      $vtExceptions{13}:="spacer"
          
      
      ARRAY TEXT($vtRighe;0)
      $SourceText:=Get text from clipboard
      
      If (OK=0)
        ALERT("Si è verificato un errore nel leggere gli appunti (procedura interrotta).")
      Else
        SET CURSOR(4)
        
        ARRAY TEXT($vtTags;0)
        ARRAY INTEGER($vtCount;0)
        ARRAY INTEGER($vtLine;0;0)
        ARRAY INTEGER($vtPosition;0;0)
        $vLineNumber:=1
        $startLine:=1
        $X:=1
        
        If ($size>3000)
          Open window((Screen width-300)/2;(Screen height-150)/2;((Screen width-300)/2)+300;((Screen height-150)/2)+150;1)
        End if
        
        Repeat
          
          $char:=($SourceText?$X?)
          GOTO XY(10;6)
          MESSAGE("Parsing: "+String($X)+" / "+String($size)+" bytes")
          
          Case of
          
           : ($char=Char(13))
           $vLineNumber:=$vLineNumber+1
           $X:=$X+1
           $startLine:=$X
          
           : ($char="<") & (($SourceText?$X+Num($X<($size+1))?)#"!") ` ignora tutti i tag che iniziano con           
           $offset:=1
           Repeat
           $offset:=$offset+1
           Until (($SourceText?$X+$offset?=">") | ($SourceText?$X+$offset?=Char(32)) | ($SourceText?$X+$offset?=Char(13)))
           $tag:=Substring($SourceText;$X+1;$offset-1)
          
           $n:=Find in array($vtExceptions;$tag)
           If ($n=-1) ` se il tag non è un'eccezione da ignorare
           If (Ascii($tag)=47) ` se il tag inizia con ascii 47 = /
           $notFound:=False
           $tag:=Substring($tag;2)
           $n:=Find in array($vtTags;$tag)
           If ($n=-1) ` è chiuso un tag che compare per la prima volta e non è presente nell'elenco dei tag esistenti
           $notFound:=True
           Else
           If (Size of array($vtLine{$n})=0)
           $notFound:=True
           Else
           DELETE ELEMENT($vtLine{$n};Size of array($vtLine{$n}))
           DELETE ELEMENT($vtPosition{$n};Size of array($vtPosition{$n}))
           End if
           End if
           If ($notFound=True)
           INSERT ELEMENT($vtErrorText;Size of array($vtErrorText)+1)
           $vtErrorText{Size of array($vtErrorText)}:=" tag chiuso senza apertura, linea "+String($vLineNumber)+" posizione "+String($X-$startLine+1)
           End if
           Else
           $n:=Find in array($vtTags;$tag)
           If ($n=-1)
           $n:=Size of array($vtTags)+1
           INSERT ELEMENT($vtTags;$n)
           INSERT ELEMENT($vtCount;$n)
           INSERT ELEMENT($vtLine;$n)
           INSERT ELEMENT($vtPosition;$n)
           End if
           $J:=Size of array($vtLine{$n})+1
           INSERT ELEMENT($vtLine{$n};$J)
           INSERT ELEMENT($vtPosition{$n};$J)
           $vtTags{$n}:=$tag
           $vtCount{$n}:=$vtCount{$n}+1
           $vtLine{$n}{$J}:=$vLineNumber
           $vtPosition{$n}{$J}:=$X-$startLine+1
           End if
          
           End if
           $X:=$X+$offset-1
           Else
           $X:=$X+1
          End case
        Until ($X>Length($SourceText))
        
        If ($size>8000)
          CLOSE WINDOW
        End if
        
        $resultText:="CHECK HTML TAGS di Roberto Vergani (05-2006)"+(Char(13)*3)
        $n:=Size of array($vtErrorText)
        $k:=0
        For ($X;1;Size of array($vtLine))
          $k:=$k+Size of array($vtLine{$X})
        End for
        If ($n>0) | ($k>0)
          $resultText:=$resultText+"### SONO STATI RILEVATI ERRORI :"+(Char(13)*2)
          For ($X;1;Size of array($vtLine))
           If (Size of array($vtLine{$X})>0)
           For ($J;1;Size of array($vtLine{$X}))
           $resultText:=$resultText+"<"+$vtTags{$X}+"> tag aperto e non chiuso, linea "+String($vtLine{$X}{$J})+" posizione "+String($vtPosition{$X}{$J})+Char(13)
           End for
           End if
          End for
          $resultText:=$resultText+Char(13)
          For ($X;1;$n)
           $resultText:=$resultText+$vtErrorText{$X}+Char(13)
          End for
          $info:="### RILEVATI ERRORI."+Char(13)
        Else
          $resultText:=$resultText+"Il codice esaminato sembra essere OK."
          $info:="Nessun errore."+Char(13)
        End if
        $resultText:=$resultText+(Char(13)*3)
        $resultText:=$resultText+"Sono stati esaminati:"+(Char(13)*2)
        For ($X;1;Size of array($vtTags))
          $value:=String($vtCount{$X}) ` riutilizzo di variabile
          $resultText:=$resultText+(" "*(5-Length($value)))+$value+" tag <"+$vtTags{$X}+">"+Char(13)
        End for
        SET TEXT TO CLIPBOARD($resultText)
        SET CURSOR(0)
        ALERT($info+"L'esito dell'elaborazione è contenuto negli appunti, incolla dove vuoi.")
      End if
    End if
End case

Chi costruisce pagine html da utilizzare in modalità non contestuale utilizzando dati e variabili in modo dinamico, in genere deve costruire blocchi di codice html che costituiscono la pagina con i dati, per esempio un blocco di intestazione, un blocco contenuto in un loop e ripetuto per ogni record, eventuali break, un blocco di fine pagina.
E’ praticamente sempre necessario costruire tabelle ed avviene spesso di commettere errori nella parità dei TAG, dove per parità intendo che ad ogni TAG di apertura corrisponda il relativo TAG di chiusura: .

Recentemente mi è avvenuto di lavorare su pagine molto complesse e, spostando blocchi di codice dentro e fuori dai loop, ad un certo punto avevo errori di visualizzazione o negli allineamenti e non riuscivo più a controllare se tutti i TAG fossero a posto. Ho cercato ma non ho trovato un applicativo semplice che controllasse il codice. Allora l’ho scritto.

E’ un method che non usa form e che si può inserire in qualunque struttura. Esamina il codice presente negli appunti ed ha quindi il limite di 32K di lunghezza del sorgente ma è più che sufficiente per l’esigenza di controllare codice in 4D.

L’uso è immediato: copiare il codice da esaminare e lanciare il method dall’ambiente user, a fine elaborazione viene prodotto un report che è collocato sempre negli appunti: incollare dove possa essere letto ed eventualmente stampato. Naturalmente questo method considera tutte le stringhe che iniziano con il carattere “<“ e il report potrebbe riportare presunti errori che invece non sono tali: basta ignorarli.

Questo method non è un semplice contatore che somma aperture e chiusure ma lavora rispettando la nidifcazione dei TAG.
Il report elenca gli errori riportando i riferimenti di riga e posizione in cui sono stati trovati. Prevede anche delle eccezioni, TAG che non hanno chiusura e che vengono ignorati; l’elenco delle eccezioni è facilmente modificabile. Può essere usato anche quando il codice html è contenuto in istruzioni 4D, esempio:



addToBody ("<table border=0 cellpadding=0 cellspacing=0 bgcolor="+Char(34)+myVar+Char(34)+">")
addToBody ("<tr>")
addToBody ("<td height=12 width=8 valign=top><img src="+Char(34)+""+Char(34)+" border=0 width=1 height=1 alt="+Char(34)+""+Char(34)+"></td>")
addToBody ("<td width=582 valign=top>")
addToBody ("<p><font size=-1><span class="+Char(34)+"style108"+Char(34)+"><font color="+ myVar+"</font></span></font></p></td>")
addToBody ("<td width=10 valign=top><img src="+Char(34)+""+Char(34)+" border=0 width=1 height=1 alt="+Char(34)+""+Char(34)+"></td>")
addToBody ("</tr>")
addToBody ("</table>")

Nel caso di codice 4D non ricompone i tag eventualmente tagliati dalle virgolette per il limite della lunghezza delle stringhe.

Mi sono divertito ad esaminare parecchie pagine scaricate qua e la per la rete ed è curioso notare quante contengano errori, errori che i browser attuali sono abbastanza intelligenti da perdonare e che quindi risultano non visibili.

In modalità client/server è possibile realizzare un sistema di messaggistica istantanea (tipo Messenger, AIM, ICQ) utilizzando pochissime righe di codice. Vediamo come.

Il seguente metodo, Registration, permette di registrare il client in modo da renderlo pronto a ricevere messaggi da altri 4D Client.


`--------------------
UNREGISTER CLIENT
Repeat
      vPseudoName:=Request("Enter your name:";"User";"OK";"Cancel")
Until ((OK=0) | (vPseudoName # ""))
If (OK=0)
      ...` Non fa niente
Else
      REGISTER CLIENT(vPseudoName)
End if
`--------------------



L'istruzione che segue mette in moto il processo che consente di ottenere la lista aggiornata dei client collegati. Una buona idea potrebbe essere quella di inserirla nel On Startup Database Method:

PrClientList:=New process("4D Client List";64000;"Lista dei registered clients")


Il metodo 4D Client List permette di ottenere la lista dei client registrati:


`--------------------
If (Application type=4D Client)
` il codice che segue è valido solo in modalità client/server
      $Ref:=Open window(100;100;300;400;-(Palette window+Has window title);"Lista dei client registrati")
      Repeat
           GET REGISTERED CLIENTS($ClientList;$ListeCharge)
           `Lista dei client in $ClientList
           ERASE WINDOW($Ref)
           GOTO XY(0;0)
           For ($p;1;Size of array($ClientList))
           MESSAGE($ClientList{$p}+Char(Carriage return))
           End for
           `lo mostra qualche secondo
           DELAY PROCESS(Current process;60)
      Until (False) ` loop infinito
End if
`--------------------


Il seguente metodo manda un messaggio a un altro 4D Client usando il metodo Display_Message


`--------------------
$Addressee:=Request("Destinatario del messaggio:";"")
` Inserire uno dei nomi visualizzati dalla finestra aperta in
` On Startup database method
If (OK # 0)
      $Message:=Request("Messaggio:") ` il messaggio
      If (OK # 0)
           EXECUTE ON CLIENT($Addressee;"Display_Message";$Message) ` manda il messaggio
      End if
End if
`--------------------



Ecco il metodo Display_Message

`--------------------

C_TEXT($1)
ALERT($1)

`--------------------



Infine, il metodo che permetta ad un client di non essere più visibile fra i client collegati in modo da non poter ricevere messaggi dovrà contenere la sola istruzione:

UNREGISTER CLIENT

In linea generale, tutte le volte che si usa un XML bisogna pulirlo alla fine, perchè l'occupazione in memoria non è della sola variabile longint Riferimento, ma di una struttura ben più grande a cui questa punta.

Quindi, la sequenza è:

1) Riferimento:=DOM Create XML Ref("XYZ")`qui lo crei

2..n) ... qui costruisci l'xml

n+1) DOM EXPORT TO VAR(Riferimento;blob) `qui lo usi, esporti, etc

n+2) DOM CLOSE XML (Riferimento) `<-----AGGIUNGI QUESTO !!!!

Da un recente "daily tip" di 4DToday, segnaliamo il codice che permette di ottenere la data del giorno di Pasqua per un certo anno, che è il parametro da passare al metodo:


C_INTEGER($1;$G;$I;$C;$H;$I;$J;$L;$M;$D)
C_STRING(6;$0)

$G:=(($1%19)+1)-1
$I:=((19*$G)+15)%30
$C:=($1\100)

$H:=($C-($C\4)-(((8*$C)+13)\25)+(19*$G)+15)%30
$I:=$H-(($H\28)*(1-((29\($H+1))*((21-$G)\11))))
$J:=($1+($1\4)+$I+2-$C+($C\4))%7
$L:=$I-$J
$M:=3+(($L+40)\44)
$D:=$L+28-(31*($M\4))

$0:=String($D;"00")+"/"+String($M;"00")+"/"+String($1)





Fonte: 4DToday
Inviato da Paul Mohammadi

Questo metodo ritorna il percorso corrente dell'applicazione compilata con l'engine o della struttura sia su Mac che su PC

` Method: dammiPercorso
C_LONGINT($lun;$pos)
C_TEXT($0;$sep;$percorso)
$sep:=system folder≤length(system folder)≥
If ((Application type=4D Runtime Volume License) & ($sep=":"))
      $percorso:=Replace string(Application file;".app";"")
Else
      $percorso:=Structure file
End if
$lun:=Length($percorso)
$pos:=$lun
Repeat
      $pos:=$pos-1
Until ($percorso?$pos?=$sep)
$0:=Substring($percorso;1;$pos)

Uno dei crucci maggiori per i programmatori è quello di mantenere il più standard possibile il proprio ambiente di lavoro. Ad esempio poter mantenere gli stessi colori per il method editor tra varie macchine.

Per rendere possibile tutto questo basta riutilizzare il file 4D Preferences 2004(.RSR) che contiene tutte le informazioni di personalizzazione dell'applicazione 4th Dimension.
Questo principio è molti utile, ad esempio, per avere tutti i client con i colori "configurati" allo stesso modo.

Le cartelle dove rintracciare il file (per 4th Dimension, 4D Server e 4D Client) si possono ottenere da questa faq.

Usando le frecce per scorrere una listbox, quando la selezione arriva ad uno degli estremi della lista (inferiore o superiore che sia), una ulteriore pressione dei tasti freccia (verso il basso o verso l'alto rispettivamente) non cambia, giustamente, la riga selezionata.
Se si vuole fare in modo che, quando la riga selezionata è l'ultima, una ulteriore pressione del tasto "Freccia giù" porti la selezione al primo elemento della listbox, basta creare un pulsante nel form, associare al pulsante lo shortcut "Down Arrow" e scrivere il seguente codice nel metodo del pulsante:

Case of
  : (Form event=On Clicked )
      If (ListBox=0)
          ListBox:=1
      Else
          ListBox:=ListBox+1
          If (ListBox>Size of array(arrEsempio))
           ListBox:=1
          End if
      End if
      SELECT LISTBOX ROW(ListBox;ListBox)
End case


Stesso principio si può adottare per un pulsante associato a "Up Arrow":


Case of
  : (Form event=On Clicked )
      ListBox:=ListBox-1
      If (ListBox<=0)
          ListBox:=Size of array(arrEsempio)
      End if
      SELECT LISTBOX ROW(ListBox;ListBox)
End case

Ecco un frammento di codice da usare per cancellare dei record selezionati in un form di output, controllando che non siano bloccati.

CREATE SET(Current form table->;"SetSelezione")
USE SET("UserSet")
DELETE SELECTION(Current form table->)
USE SET("OriginalSet")

$lockedRecords:=Records in set("LockedSet")
Case of
    :($lockedRecords=1)
           $msg:=”Un record è bloccato e non può essere cancellato. Lo visualizzo?“
    :($lockedRecords>1)
           $msg:=”Alcuni record sono bloccati e non possono essere cancellati. Li visualizzo?“
    Else
           $msg:=””
End case
If ($lockedRecords#0)
    CONFIRM$msg;"Yes";"No")
    If (OK=1)
        USE SET("LockedSet")
    End if
    CLEAR SET("LockedSet")
End if
    
CLEAR SET("SetSelezione ")
FLUSH BUFFERS

Per altre informazioni sull'uso dei set consultare questa faq.

Per dimostrare l'equivalenza tra procedure iterative e procedure ricorsive, pubblichiamo due metodi per risolvere uno schema Sudoku 9x9x9.
Ecco la soluzione del Sudoku ricorsiva:

`Solver
$prossimo:=$1
If ($prossimo>0)
        $row:=($prossimo\9)+(1*Num(Mod($prossimo;9)>0))
        $column:=$prossimo-(($row-1)*9)
        $0:=False
        For ($i;1;9)
           arrValori{$row}{$column}:=$i
           If (CheckRules ($row;$column))
           $0:=Solver (GetNext )
           End if
           If ($0)
           $i:=12
           End if
        End for
        If ($0=False)
           arrValori{$row}{$column}:=0
        End if
Else
        $0:=True
End if


`CheckRules
$0:=True
$row:=$1
$column:=$2
$valore:=arrValori{$row}{$column}
For ($i;1;9)
        If ((($i#$row) & (arrValori{$i}{$column}=$valore)) | (($i#$column) & (arrValori{$row}{$i}=$valore)))
           $0:=False
           $i:=12
        End if
End for
If ($0)
        $firstcol:=($column-1\3)*3
        $firstrow:=($row-1\3)*3
        For ($i;1;3)
           For ($j;1;3)
           $checkRow:=$firstrow+$i
           $checkCol:=$firstcol+$j
           If ((Not(($checkRow=$row) & ($checkCol=$column))) & (arrValori{$checkRow}{$checkCol}=$valore))
           $0:=False
           $i:=12
           $j:=12
           End if
           End for
        End for
End if


`GetNext
ARRAY LONGINT($arrPosizione;0)
ARRAY LONGINT($arrQuanti;0)
For ($i;1;9)
        For ($j;1;9)
           If ((arrFissi{$i}{$j}=False) & (arrValori{$i}{$j}=0))
           INSERT ELEMENT($arrPosizione;Size of array($arrPosizione)+1)
           INSERT ELEMENT($arrQuanti;Size of array($arrQuanti)+1)
           $arrPosizione{Size of array($arrPosizione)}:=(($i-1)*9)+$j
           For ($valore;1;9)
           arrValori{$i}{$j}:=$valore
           If (CheckRules ($i;$j))
           $arrQuanti{Size of array($arrQuanti)}:=$arrQuanti{Size of array($arrQuanti)}+1
           End if
           End for
           arrValori{$i}{$j}:=0
           End if
        End for
End for
MULTI SORT ARRAY($arrQuanti;>;$arrPosizione;>)
If (Size of array($arrQuanti)>0)
        $0:=$arrPosizione{1}
Else
        $0:=0
End if

Diamo seguito ad una faq precedente, pubblicando i metodi che permettono di risolvere un problema Sudoku utilizzando un sistema di programmazione iterativo.

`btElabora
ARRAY INTEGER(assudo;729)
ARRAY INTEGER(supos;81)
ARRAY INTEGER(sudo;81)

$x:=1
Repeat
    $pvar:=Get pointer("sudo"+String($x))
    If ($pvar->="")
        sudo{$x}:=0
    Else
        sudo{$x}:=Num($pvar->)
    End if
    $x:=$x+1
Until ($x>81)

$pp:=sudoarr (1)

$x:=1
Repeat
    supos{$x}:=0
    $x:=$x+1
Until ($x>81)



ARRAY INTEGER($vuoti;0)
$x:=1
$y:=1
Repeat
    
    If (sudo{$x}=0)
        INSERT ELEMENT($vuoti;$y)
        $vuoti{$y}:=$x
        $y:=$y+1
    End if
    $x:=$x+1
Until ($x>81)



$tempo:=Tickcount
    `Open window(200;200;300;350;16;"Elaborazione")
Open window(200;200;340;350;16;"Elaborazione")
sudomess

$x:=1


Repeat
    
    $posa:=supos{$vuoti{$x}}+1
    $posass:=($vuoti{$x}*9)-8
    
    If ($posa<10)
        supos{$vuoti{$x}}:=$posa
        sudo{$vuoti{$x}}:=assudo{$posass+$posa-1}
        sudomess
        If (assudo{$posass+$posa-1}#0)
          
           If ($x           $pp:=sudoarr ($vuoti{$x}+1)
           Else
           $pp:=True
           End if
           If ($pp)
           $x:=$x+1
           Else
           sudo{$vuoti{$x}}:=0
           sudomess
           If (assudo{$posass+$posa}=0)
           supos{$vuoti{$x}}:=0
           $x:=$x-1
           End if
          
           End if
        Else
           sudo{$vuoti{$x}}:=0
           sudomess
           supos{$vuoti{$x}}:=0
           $x:=$x-1
        End if
    Else
        sudo{$vuoti{$x}}:=0
        sudomess
        supos{$vuoti{$x}}:=0
        $x:=$x-1
    End if
    
    
Until ($x>Size of array($vuoti)) | ($x<1)

CLOSE WINDOW

$x:=1
Repeat
    $pvar:=Get pointer("sudo"+String($vuoti{$x}))
    $pvar->:=String(sudo{$vuoti{$x}})
    $x:=$x+1
Until ($x>Size of array($vuoti))

If ($x<1)
    ALERT("SOLUZIONE IMPOSSIBILE")
Else
    ALERT("Risolto in "+String(Int((Tickcount-$tempo)/60))+" secondi")
End if


`sudomess
riga1:=String(sudo{1})+" "+String(sudo{2})+" "+String(sudo{3})+" "+String(sudo{4})+" "+String(sudo{5})+" "+String(sudo{6})+" "+String(sudo{7})+" "+String(sudo{8})+" "+String(sudo{9})
riga2:=String(sudo{10})+" "+String(sudo{11})+" "+String(sudo{12})+" "+String(sudo{13})+" "+String(sudo{14})+" "+String(sudo{15})+" "+String(sudo{16})+" "+String(sudo{17})+" "+String(sudo{18})
riga3:=String(sudo{19})+" "+String(sudo{20})+" "+String(sudo{21})+" "+String(sudo{22})+" "+String(sudo{23})+" "+String(sudo{24})+" "+String(sudo{25})+" "+String(sudo{26})+" "+String(sudo{27})
riga4:=String(sudo{28})+" "+String(sudo{29})+" "+String(sudo{30})+" "+String(sudo{31})+" "+String(sudo{32})+" "+String(sudo{33})+" "+String(sudo{34})+" "+String(sudo{35})+" "+String(sudo{36})
riga5:=String(sudo{37})+" "+String(sudo{38})+" "+String(sudo{39})+" "+String(sudo{40})+" "+String(sudo{41})+" "+String(sudo{42})+" "+String(sudo{43})+" "+String(sudo{44})+" "+String(sudo{45})
riga6:=String(sudo{46})+" "+String(sudo{47})+" "+String(sudo{48})+" "+String(sudo{49})+" "+String(sudo{50})+" "+String(sudo{51})+" "+String(sudo{52})+" "+String(sudo{53})+" "+String(sudo{54})
riga7:=String(sudo{55})+" "+String(sudo{56})+" "+String(sudo{57})+" "+String(sudo{58})+" "+String(sudo{59})+" "+String(sudo{60})+" "+String(sudo{61})+" "+String(sudo{62})+" "+String(sudo{63})
riga8:=String(sudo{64})+" "+String(sudo{65})+" "+String(sudo{66})+" "+String(sudo{67})+" "+String(sudo{68})+" "+String(sudo{69})+" "+String(sudo{70})+" "+String(sudo{71})+" "+String(sudo{72})
riga9:=String(sudo{73})+" "+String(sudo{74})+" "+String(sudo{75})+" "+String(sudo{76})+" "+String(sudo{77})+" "+String(sudo{78})+" "+String(sudo{79})+" "+String(sudo{80})+" "+String(sudo{81})

GOTO XY(2;1)
MESSAGE(riga1)
GOTO XY(2;2)
MESSAGE(riga2)
GOTO XY(2;3)
MESSAGE(riga3)
GOTO XY(2;4)
MESSAGE(riga4)
GOTO XY(2;5)
MESSAGE(riga5)
GOTO XY(2;6)
MESSAGE(riga6)
GOTO XY(2;7)
MESSAGE(riga7)
GOTO XY(2;8)
MESSAGE(riga8)
GOTO XY(2;9)
MESSAGE(riga9)



`sudoarr
C_INTEGER($1)
C_BOOLEAN($0)
$pieno:=True
$x:=$1
Repeat
    $posass:=($x*9)-8
    If (sudo{$x}=0)
        $z:=$posass
        $zz:=1
        Repeat
           assudo{$z}:=0
           $z:=$z+1
           $zz:=$zz+1
        Until ($zz>9)
        $y:=1
        $pos:=0
        $arr:=0
        sudopos ($x)
        Repeat
           If (ChkRiga ($x;$y))
           assudo{$posass+$pos}:=$y
           $arr:=$arr+assudo{$posass+$pos}
           $pos:=$pos+1
           End if
           $y:=$y+1
        Until ($y>9)
        If ($arr=0)
           $pieno:=False
        End if
    End if
    $x:=$x+1
Until ($x>81) | ($pieno=False)
$0:=$pieno



`sudopos
C_INTEGER($1)
C_BOOLEAN($0)
$pieno:=True
$x:=$1
Repeat
    $posass:=($x*9)-8
    If (sudo{$x}=0)
        $z:=$posass
        $zz:=1
        Repeat
           assudo{$z}:=0
           $z:=$z+1
           $zz:=$zz+1
        Until ($zz>9)
        $y:=1
        $pos:=0
        $arr:=0
        sudopos ($x)
        Repeat
           If (ChkRiga ($x;$y))
           assudo{$posass+$pos}:=$y
           $arr:=$arr+assudo{$posass+$pos}
           $pos:=$pos+1
           End if
           $y:=$y+1
        Until ($y>9)
        If ($arr=0)
           $pieno:=False
        End if
    End if
    $x:=$x+1
Until ($x>81) | ($pieno=False)
$0:=$pieno


`ChkRiga
C_INTEGER($1)
C_INTEGER($2)
C_BOOLEAN($0)

$giusto:=True
$cas:=$1
$num:=$2


$inriga:=suriga*9-8
$finriga:=$inriga+8

Repeat
    If (sudo{$inriga}=$num)
        $giusto:=False
    End if
    $inriga:=$inriga+1
Until ($giusto=False) | ($inriga>$finriga)

If ($giusto)
    $incol:=sucol
    $fincol:=72+sucol
    Repeat
        If (sudo{$incol}=$num)
           $giusto:=False
        End if
        $incol:=$incol+9
    Until ($giusto=False) | ($incol>$fincol)
    
    If ($giusto)
        $inq:=suiq
        $finq:=suiq+20
        
        $x:=1
        Repeat
           If (sudo{$inq}=$num)
           $giusto:=False
           End if
           If ($x=3)
           $inq:=$inq+7
           $x:=1
           Else
           $inq:=$inq+1
           $x:=$x+1
           End if
          
        Until ($giusto=False) | ($inq>$finq)
        
    End if
    
End if

$0:=$giusto

Informazioni sull'utilizzo del seguente metodo è spiegato nella faq Calcolo della linea di tendenza polinomiale in un grafico

    ` Method_CalcoloCoefficienti
    ` Roberto Vergani Luglio 2002

    ` Regressione Polinomiale
    ` equazione normale della parabola dei minimi quadrati.
    ` Sistema lineare di 3 equazioni nelle incognite A, B e C
    ` Calcolo dei coefficienti

C_INTEGER($X;$elementi)
C_REAL($somma_X;$somma_Y;$sommaQuadrati_X;$sommaCubo_X;$sommaQuarta_X;$somma_XY;$somma_QuadratoX_Y)
C_REAL($determinante_A;$determinante_A1;$determinante_A2;$determinante_A3)
C_REAL($elementi;$costante_A;$costante_B;$costante_C)
C_POINTER($1)
C_REAL(vReal_Coefficiente_A;vReal_Coefficiente_B;vReal_Coefficiente_C)
C_INTEGER(

$elementi:=Size of array($1->)

$somma_X:=0
$somma_Y:=0
$sommaQuadrati_X:=0
$sommaCubo_X:=0
$sommaQuarta_X:=0
$somma_XY:=0
$somma_QuadratoX_Y:=0

For ($X;1;$elementi)
        $somma_X:=$somma_X+$X
        $somma_Y:=$somma_Y+($1->{$X})
        $sommaQuadrati_X:=$sommaQuadrati_X+($X^2)
        $sommaCubo_X:=$sommaCubo_X+($X^3)
        $sommaQuarta_X:=$sommaQuarta_X+($X^4)
        $somma_XY:=$somma_XY+($X*($1->{$X}))
        $somma_QuadratoX_Y:=$somma_QuadratoX_Y+(($X^2)*($1->{$X}))
End for

    ` soluzione con il metodo di Cramer
    ` descrizione del sistema

    ` Σ_Quarta_X*a + Σ_Cubo_X*b + Σ_Quadrati_X*c = Σ_QuadratoX_Y
    ` Σ_Cubo_X*a + Σ_Quadrati_X*b + Σ_X*c = ?__XY
    ` Σ_Quadrati_X*a + Σ__X*b + $elementi*c = ?__Y

    ` ==== MATRICE DEI COEFFICIENTI

    ` Tabella mnemorica della matrice
    ` {1}{1} {1}{2} {1}{3}
    ` {2}{1} {2}{2} {2}{3}
    ` {3}{1} {3}{2} {3}{3}

ARRAY REAL($matrice;3;3) ` matrice quadrata di ordine tre (allocata come vettore di reali bidimensionale)

$matrice{1}{1}:=$sommaQuarta_X
$matrice{1}{2}:=$sommaCubo_X
$matrice{1}{3}:=$sommaQuadrati_X
$matrice{2}{1}:=$sommaCubo_X
$matrice{2}{2}:=$sommaQuadrati_X
$matrice{2}{3}:=$somma_X
$matrice{3}{1}:=$sommaQuadrati_X
$matrice{3}{2}:=$somma_X
$matrice{3}{3}:=$elementi

    ` CALCOLO DETERMINANTE DI A (non uso un loop per maggiore leggibilità)
    ` diagonali discendenti
$determinante_A:=$matrice{1}{1}*$matrice{2}{2}*$matrice{3}{3}
$determinante_A:=$determinante_A+($matrice{1}{2}*$matrice{2}{3}*$matrice{3}{1})
$determinante_A:=$determinante_A+($matrice{1}{3}*$matrice{2}{1}*$matrice{3}{2})
    ` diagonali ascendenti
$determinante_A:=$determinante_A-($matrice{3}{1}*$matrice{2}{2}*$matrice{1}{3})
$determinante_A:=$determinante_A-($matrice{3}{2}*$matrice{2}{3}*$matrice{1}{1})
$determinante_A:=$determinante_A-($matrice{3}{3}*$matrice{2}{1}*$matrice{1}{2})

If ($determinante_A#0) ` altrimenti il sistema è incompatibile o non determinato
        
           ` Sostituzione della colonna 1 con i termini noti dell'equazione
        $matrice{1}{1}:=$somma_QuadratoX_Y
        $matrice{2}{1}:=$somma_XY
        $matrice{3}{1}:=$somma_Y
        
           ` CALCOLO DETERMINANTE DI A1
           ` diagonali discendenti
        $determinante_A1:=$matrice{1}{1}*$matrice{2}{2}*$matrice{3}{3}
        $determinante_A1:=$determinante_A1+($matrice{1}{2}*$matrice{2}{3}*$matrice{3}{1})
        $determinante_A1:=$determinante_A1+($matrice{1}{3}*$matrice{2}{1}*$matrice{3}{2})
           ` diagonali ascendenti
        $determinante_A1:=$determinante_A1-($matrice{3}{1}*$matrice{2}{2}*$matrice{1}{3})
        $determinante_A1:=$determinante_A1-($matrice{3}{2}*$matrice{2}{3}*$matrice{1}{1})
        $determinante_A1:=$determinante_A1-($matrice{3}{3}*$matrice{2}{1}*$matrice{1}{2})
        
           ` Sostituzione della colonna 2 con i termini noti dell'equazione
           ` (previo ripristino della colonna 1 ai valori della Matrice A)
        $matrice{1}{1}:=$sommaQuarta_X
        $matrice{2}{1}:=$sommaCubo_X
        $matrice{3}{1}:=$sommaQuadrati_X
        
        $matrice{1}{2}:=$somma_QuadratoX_Y
        $matrice{2}{2}:=$somma_XY
        $matrice{3}{2}:=$somma_Y
        
           ` CALCOLO DETERMINANTE DI A2
           ` diagonali discendenti
        $determinante_A2:=$matrice{1}{1}*$matrice{2}{2}*$matrice{3}{3}
        $determinante_A2:=$determinante_A2+($matrice{1}{2}*$matrice{2}{3}*$matrice{3}{1})
        $determinante_A2:=$determinante_A2+($matrice{1}{3}*$matrice{2}{1}*$matrice{3}{2})
           ` diagonali ascendenti
        $determinante_A2:=$determinante_A2-($matrice{3}{1}*$matrice{2}{2}*$matrice{1}{3})
        $determinante_A2:=$determinante_A2-($matrice{3}{2}*$matrice{2}{3}*$matrice{1}{1})
        $determinante_A2:=$determinante_A2-($matrice{3}{3}*$matrice{2}{1}*$matrice{1}{2})
        
           ` Sostituzione della colonna 3 con i termini noti dell'equazione
           ` (previo ripristino della colonna 2 ai valori della Matrice A)
        $matrice{1}{2}:=$sommaCubo_X
        $matrice{2}{2}:=$sommaQuadrati_X
        $matrice{3}{2}:=$somma_X
        
        $matrice{1}{3}:=$somma_QuadratoX_Y
        $matrice{2}{3}:=$somma_XY
        $matrice{3}{3}:=$somma_Y
        
           ` CALCOLO DETERMINANTE DI A3
           ` diagonali discendenti
        $determinante_A3:=$matrice{1}{1}*$matrice{2}{2}*$matrice{3}{3}
        $determinante_A3:=$determinante_A3+($matrice{1}{2}*$matrice{2}{3}*$matrice{3}{1})
        $determinante_A3:=$determinante_A3+($matrice{1}{3}*$matrice{2}{1}*$matrice{3}{2})
           ` diagonali ascendenti
        $determinante_A3:=$determinante_A3-($matrice{3}{1}*$matrice{2}{2}*$matrice{1}{3})
        $determinante_A3:=$determinante_A3-($matrice{3}{2}*$matrice{2}{3}*$matrice{1}{1})
        $determinante_A3:=$determinante_A3-($matrice{3}{3}*$matrice{2}{1}*$matrice{1}{2})
        
           ` terna soluzione
        vReal_Coefficiente_A:=$determinante_A1/$determinante_A
        vReal_Coefficiente_B:=$determinante_A2/$determinante_A
        vReal_Coefficiente_C:=$determinante_A3/$determinante_A
        
Else
        vReal_Coefficiente_A:=0
        vReal_Coefficiente_B:=0
        vReal_Coefficiente_C:=0
End if

Dal forum tecnico italiano pubblico il procedimento da seguire per riempire una combo su una pagina web.

Nella pagina web viene inserito il seguente testo:

&lt;!--#4DSCRIPT/Web_CaricaArray--&gt; : The method does not exist. : The method does not exist. : The method does not exist.

Ecco il metodo Web_CaricaArray

C_TEXT($0;$1)
ALL RECORDS([Pazienti])
ORDER BY([Pazienti];[Pazienti]Cognome)
$menu:=Char(1)+"<"+"select name=\"SelectableList\">\r"
FIRST RECORD([Pazienti])
While (Not(End selection([Pazienti])))
      $menu:=$menu+"<"+"option value=\""+[Pazienti]Cognome+"\">"+[Pazienti]Cognome+"\r"
      NEXT RECORD([Pazienti])
End while
$menu:=$menu+""
$0:=$menu

Due cose da notare:
- il value è quello che ritorna dopo che l'utente ha selezionato qualcosa
- il Char(1) come primo carattere iniziale segnala a 4d che il testo che si invia è codice html (altrimenti lui sostituisce i caratteri < con il simbolo & lt; per mostrarli bene a video come testo).

Non tutti hanno l'insider per spostare le immagini da un applicativo all'altro, questo metodo consente di copiarle da e verso un Table

ARRAY LONGINT($Riferimento;0)
ARRAY STRING(80;$Nomi;0)
PICTURE LIBRARY LIST($Riferimento;$Nomi)

If (True)
  ALL RECORDS([IMMAGINI])
  While (Not(End selection([IMMAGINI])))
    $i:=Find in array($Riferimento;[IMMAGINI]Riferimento)
    If ($i<1)
      SET PICTURE TO LIBRARY([IMMAGINI]Immagine;[IMMAGINI]Riferimento;[IMMAGINI]Nome)
    End if
    NEXT RECORD([IMMAGINI])
  End while
Else
  C_PICTURE($Picture)
  READ WRITE([IMMAGINI])
  
  If (Size of array($Riferimento)>0)
    For ($i;1;Size of array($Riferimento))
      GET PICTURE FROM LIBRARY($Riferimento{$i};$Picture)
      QUERY([IMMAGINI];[IMMAGINI]Riferimento=$Riferimento{$i})
      If (Records in selection([IMMAGINI])=0)
        CREATE RECORD([IMMAGINI])
        [IMMAGINI]Riferimento:=$Riferimento{$i}
        [IMMAGINI]Nome:=$Nomi{$i}
        [IMMAGINI]Immagine:=$Picture
        SAVE RECORD([IMMAGINI])
        UNLOAD RECORD([IMMAGINI])
      End if
    End for
  End if
End if

Quando si importano in 4d file di testo la creazione delle tabelle viene fatto in automatico le lunghezze dei campi Alpha è di default 80. Ecco un metodo da usare per analizzare il contenuto di tutte le tabelle di un database per trovare per i campi testo o alpha la stringa più lunga (con l'esempio più lungo) e quante volte il campo è usato.

`Nexus srl www.nexusonline.it
`Umberto Migliore 29 nov 2005
READ ONLY(*)
$doc:=Create document("")
If (ok=1)
  $cr:=Char(Carriage return )
  $tab:=Char(Tab )
  
  For ($t;1;Count tables)
    $table_ptr:=Table($t)
    DEFAULT TABLE($table_ptr->)
    SEND PACKET($doc;Table name($t)+$tab+String(Records in table)+" recs"+$cr)
    $quanti:=Count fields($t)
    ARRAY LONGINT($quantiUsati_al;$quanti)
    ARRAY LONGINT($maxLun_al;$quanti)
    ARRAY TEXT($maxTesto_at;$quanti)
    For ($f;1;$quanti)
      $quantiUsati_al{$f}:=0
      $maxLun_al{$f}:=0
      $maxTesto_at{$f}:=""
    End for
    
    ALL RECORDS
    While (Not(End selection))
      If (Mod(Selected record number;100)=0)
        MESSAGE(Table name($t)+": "+String(Selected record number)+"/"+String(Records in table))
      End if
      
      For ($f;1;$quanti)
        $field_ptr:=Field($t;$f)
        If ((Type($field_ptr->)=Is Alpha Field ) | (Type($field_ptr->)=Is Text ))
          $text:=u_EliminaSpazi ($field_ptr->)
          $len:=Length($text)
          If ($len>0)
           $quantiUsati_al{$f}:=$quantiUsati_al+1
           If ($len>$maxLun_al{$f})
           $maxLun_al{$f}:=$len
           $maxTesto_at{$f}:=$text
           End if
          End if
        Else
          $maxLun_al{$f}:=-1
        End if
        
      End for
      
      NEXT RECORD($table_ptr->)
    End while
    
    For ($f;1;$quanti)
      SEND PACKET($doc;Field name($t;$f)+$tab+String($quantiUsati_al{$f})+$tab+String($maxLun_al{$f})+$tab+$maxTesto_at{$f}+$cr)
    End for
    
  End for
  CLOSE DOCUMENT($doc)
End if

A differenza di SET CHANNEL, che apre le porte seriali passando il numero di porta COM da usare, Serial ToolKit apre le porte in base al numero di COM installate, indipendentemente dal loro indirizzo: il che significa che potrei dover passare l'indirizzo 2 a Serial ToolKit per aprire la COM1.
Per ottenere il mumero di porta corretto si usa la funzione STK_CountPorts per conoscere il numero di porte installate, e un ciclo ($i da 1 a STK_CountPorts) in cui chiedere a STK_GetIndPort se $i vale il numero corrispondente alla porta COM che ci interessa.

C_LONGINT($Table_l;$i)
DEFAULT TABLE([Strutture])

$Table_l:=Table(Current default table)
$doc:=Create document("")
If (ok=1)
  SEND PACKET($doc;"TABLE "+Table name($Table_l)+Char(Carriage return))
  For ($i;1;Count fields($Table_l))
    $t:=Type(Field($Table_l;$i)->)
    Case of
      : (($t=Is LongInt ) | ($t=Is Integer ))
        $tipo:="Long"
      : ($t=Is Real )
        $tipo:="Real"
      : ($t=Is Alpha Field )
        $tipo:="Alfa"
      : ($t=Is Text )
        $tipo:="Text"
      : ($t=Is Boolean )
        $tipo:="Bool"
      : ($t=Is Date )
        $tipo:="Date"
      : ($t=Is Time )
        $tipo:="Time"
      : ($t=Is Picture )
        $tipo:="Pict"
      Else
        $tipo:="blob "+String($t)
    End case
    SEND PACKET($doc;Char(Tab)+$tipo+Field name($Table_l;$i)+Char(Carriage return))
    
  End for
  CLOSE DOCUMENT($doc)
End if

Le funzioni AP ShellExecute e AP Sublaunch, inserite o modificate a partire dal 4D Pack della versione 6.8.2, permettono di lanciare applicazioni esterne o aprire file. Ad esempio:

$err:=AP ShellExecute ("C:\Test.doc")

oppure

$err:=AP ShellExecute ("MacHD:Test.doc")

Ma si può anche fare in modo che il file venga aperto da una applicazione specifica, utilizzando ad esempio AP Sublaunch in questo modo:

$err:=AP Sublaunch ("C:\\Programmi\\Microsoft Office\\OFFICE11\\WINWORD.EXE c:\\Test.doc")

Per il lancio di applicazioni esterne con la versione 2004 vi rimando a questa faq.


Per l'uso di "\\" per il passaggio di percorsi Windows vi rimando a questa faq.

Per aprire una voce di Pannello di Controllo usando AP Sublaunch si può vedere questa faq.

Sempre da Math4D pubblichiamo il metodo per il calcolo della varianza di una serie, dove la serie è passata al metodo come puntatore ad un array. La varianza è data dalla formula:

Sommatoria(x^2)/n - (Sommatoria(x)/n)^2

Ecco il metodo:

$k:=Size of array($1->)
$x2:=0
$x:=0

For ($i;1;$k)
      $x2:=$x2+($1->{$i}^2)  `Sommatoria(x2)
      $x:=$x+$1->{$i}  ` Sommatoria(x)
End for

$0:=$k*$x2  ` Dimensione array*Sommatoria(x^2)
$0:=$0-($x^2)  ` nSommatoria(x^2) - (Sommatoria(x))2
$0:=$0/($k^2)  ` (nSommatoria(x2) - (Sommatoria(x))2) / n2

Il modo più semplice è usare il comando IT_MyTCPAddr del plugin 4d Internet Command (gratuito e incluso con 4d).

Il comando richiede due parametri di tipo Stringa, dove il comando ritorna il numero IP corrente e la corrispondente maschera di Subnet.
Ecco un esempio di utilizzo:

C_TEXT($indirizzo_t;$subnet_t)
C_LONGINT($errorCode_l)
$errorCode_l := IT_MyTCPAddr ($indirizzo_t; $subnet_t)
If ($errorCode_l =0)
  ALERT("IP address: " + $indirizzo_t + "\n" + "Subnet Mask: "+ $subnet_t)
End if

Questo è l'indirizzo con cui siete identificati nella rete locale; se però volete sapere qual'è l'indirizzo con cui siete visti su Internet il problema è più ampio. Se usate un modem vi viene assegnato un numero tutte le volte che telefonate; altrimenti nella maggior parte dei casi è il numero con cui il router accede ad internet.

Per saperlo da programma è necessario utilizzare un server esterno che ci dica come ci vede: ad esempio potete usare il server Nexus WS Server con una semplice chiamata Web Service.
Ecco un esempio con il codice in 4d per ottenere l'indirizzo ip pubblico.

Per completare l'argomento iniziato con la faq precedente ecco il metodo di conversione di un numero in notazione araba in notazione romana.


C_STRING(255;$0;$risultatoRomano_S)
C_INTEGER($1;$numeroArabo_I)
C_BOOLEAN($finito_B)
C_STRING(2;$decina_S;$cinquina_S;$unità_S)
C_STRING(4;$prefissi_S)

    `inizializzazione
$finito_B:=False
$numeroArabo_I:=$1
$risultatoRomano_S:=""
MATHERROR:=0
    `calcolo
Repeat
      $num:=$numeroArabo_I
      Case of
           : ($num>999)
           $prefissi_S:="M"*Num(Substring(String($numeroArabo_I);1;1))
           : ($num>99)
           $unità_S:="C"
           $cinquina_S:="D"
           $decina_S:="M"
           : ($num>9)
           $unità_S:="X"
           $cinquina_S:="L"
           $decina_S:="C"
           Else
           $unità_S:="I"
           $cinquina_S:="V"
           $decina_S:="X"
      End case
      If ($num<1000)
           $num:=Num(Substring(String($numeroArabo_I);1;1))
           $prefissi_S:=""
           Case of
           : ($num<4)
           $prefissi_S:=$unità_S*$num
           : ($num=4)
           $prefissi_S:=$unità_S+$cinquina_S
           : ($num=5)
           $prefissi_S:=$cinquina_S
           : ($num<9)
           $prefissi_S:=$cinquina_S+($unità_S*($num-5))
           : ($num=9)
           $prefissi_S:=$unità_S+$decina_S
           End case
      End if
      $risultatoRomano_S:=$risultatoRomano_S+$prefissi_S
      $numeroArabo_I:=Num(Substring(String($numeroArabo_I);2))
      $finito_B:=($numeroArabo_I<=0)
Until ($finito_B=True)

$0:=$risultatoRomano_S

Pubblichiamo di seguito una versione tradotta del metodo "MATH_RomainVersArabe" presente nella libreria Math4Dv2. il metodo prende come parametro una stringa in forma "romana" e restituisce l'equivalente in numeri arabi:

C_STRING(80;$1)
C_INTEGER($0;$risultatoArabo_L)

    `inizializzazione
$numeroRomano_S:=$1
$risultatoArabo_L:=0
MATHERROR:=0

    `calcolo
Repeat
  Case of
    : ($numeroRomano_S[[1]]="M")
      $risultatoArabo_L:=$risultatoArabo_L+1000
      $numeroRomano_S:=Substring($numeroRomano_S;2)

    : ($numeroRomano_S[[1]]="D")
      $risultatoArabo_L:=$risultatoArabo_L+500
      $numeroRomano_S:=Substring($numeroRomano_S;2)

    : ($numeroRomano_S[[1]]="C")
      Case of
        : (Length($numeroRomano_S)=1)
          $risultatoArabo_L:=$risultatoArabo_L+100
          $numeroRomano_S:=""
        : ($numeroRomano_S[[2]]="M")
          $risultatoArabo_L:=$risultatoArabo_L+900
          $numeroRomano_S:=Substring($numeroRomano_S;3)
        : ($numeroRomano_S[[2]]="D")
          $risultatoArabo_L:=$risultatoArabo_L+400
          $numeroRomano_S:=Substring($numeroRomano_S;3)
        Else
          $risultatoArabo_L:=$risultatoArabo_L+100
          $numeroRomano_S:=Substring($numeroRomano_S;2)
        End case

    : ($numeroRomano_S[[1]]="L")
      $risultatoArabo_L:=$risultatoArabo_L+50
      $numeroRomano_S:=Substring($numeroRomano_S;2)

    : ($numeroRomano_S[[1]]="X")
        Case of
        : (Length($numeroRomano_S)=1)
          $risultatoArabo_L:=$risultatoArabo_L+10
          $numeroRomano_S:=""
        : ($numeroRomano_S[[2]]="C")
          $risultatoArabo_L:=$risultatoArabo_L+90
          $numeroRomano_S:=Substring($numeroRomano_S;3)
        : ($numeroRomano_S[[2]]="L")
          $risultatoArabo_L:=$risultatoArabo_L+40
          $numeroRomano_S:=Substring($numeroRomano_S;3)
        Else
          $risultatoArabo_L:=$risultatoArabo_L+10
          $numeroRomano_S:=Substring($numeroRomano_S;2)
        End case

    : ($numeroRomano_S[[1]]="V")
      $risultatoArabo_L:=$risultatoArabo_L+5
      $numeroRomano_S:=Substring($numeroRomano_S;2)

    : ($numeroRomano_S[[1]]="I")
      Case of
        : (Length($numeroRomano_S)=1)
          $risultatoArabo_L:=$risultatoArabo_L+1
          $numeroRomano_S:=""
        : ($numeroRomano_S[[2]]="X")
          $risultatoArabo_L:=$risultatoArabo_L+9
          $numeroRomano_S:=Substring($numeroRomano_S;3)
        : ($numeroRomano_S[[2]]="V")
          $risultatoArabo_L:=$risultatoArabo_L+4
          $numeroRomano_S:=Substring($numeroRomano_S;3)
        Else
          $risultatoArabo_L:=$risultatoArabo_L+1
          $numeroRomano_S:=Substring($numeroRomano_S;2)
      End case
    Else
      MATHERROR:=-1  `numero inesistente
      $numeroRomano_S:=""
      $risultatoArabo_L:=0
  End case
Until ($numeroRomano_S="")

$0:=$risultatoArabo_L




Autori, redattori e collaboratori per Math4Dv2:
Jacques Bossy
Philip Burns
Olivier Deschanels
Marc Duc-Jacquet
Bernard Escaich
Antoine Galmiche
Micaël Germann
Teddy Linet
Frédéric Quoirez
Michel Saiz
Robert Van Loo

Tutto quello che serve per ascoltare un file MP3 è un lettore di file MP3! All'interno di questi file sono celate delle informazioni suppletive sul brano.
Un esempio di struttura di tali tag:

000-002 03 bytes TAG ID -> "TAG"
003-032 30 bytes Titolo del brano
033-062 30 bytes Nome dell'interprete
063-092 30 bytes Album
093-096 04 bytes Anno
097-127 30 bytes Commenti
128-128 01 byte Tipo

Utilizzando i comandi Open document, SET DOCUMENT POSITION e RECEIVE PACKET possiamo scriverci un metodo che inserisce in un array (passato come secondo parametro) i tag ID3 di un file MP3 (il cui percorso completo viene passato come primo parametro).

C_TEXT($1) `percorso del file
C_POINTER($2) `puntatore all'array con 7 posti che riceve i tag
C_TEXT($MyText)
C_STRING(3;$Tag)
C_LONGINT($MyOffset)
$RefDoc:=Open document($1;"")
If (ok=1)
      `Leggo gli ultimi 128 bytes del file MP3
      SET DOCUMENT POSITION($RefDoc;-128;2)
      RECEIVE PACKET($RefDoc;$MyText;500)
      CLOSE DOCUMENT($RefDoc)
  
      $Tag:=$MyText[[1]]+$MyText[[2]]+$MyText[[3]]
      If ($Tag="TAG") `c'è un tag MP3
           $2->{1}:=EliminaSpazi (Substring($MyText;4;30))
           $2->{2}:=EliminaSpazi (Substring($MyText;34;30))
           $2->{3}:=EliminaSpazi (Substring($MyText;64;30))
           $2->{4}:=EliminaSpazi (Substring($MyText;94;4))
           $2->{5}:=EliminaSpazi (Substring($MyText;98;30))
           If ((Ascii(Substring($MyText;128;1))+1)<=Size of array(<>tType))
           $2->{6}:=<>tType{Ascii(Substring($MyText;128;1))+1}
           End if
      Else
           ALERT("No MP3 Tag.")
        End if
        $2->{7}:=$1
End if

Il metodo EliminaSpazi si trova in questa faq.

A volte capita di modificare il logo nei formati, questo metodo magari non risolve tutte le casistiche ma ridimensiona al vertice in alto a sinistra

If (False)
  ` $1 = Puntatore alla variabile contenente il Logo
  ` $2 = Altezza del campo che si vuole ottenere
  ` $3 = Larghezza del campo che si vuole ottenere
  ` $4 = Object Name della variabile

  ` Inserire il richiamo a questo metodo nell'oggetto del form

AdeguaLogo (->var_Logo;114;0;"Logo")

  ` con evento "On printing detail" - "On display detail"
  ` Sembra che funzioni solo su Variabili
End if

C_INTEGER($AltezzaPrevistaInPixel;$LarghezzaPrevistaInPixel;$SizeOrizzontale;$SizeVerticale)

$AltezzaPrevistaInPixel:=$2
$LarghezzaPrevistaInPixel:=$3
PICTURE PROPERTIES($1->;$Larghezza;$Altezza)
Case of
: ($AltezzaPrevistaInPixel>0)
$Coefficiente:=$Altezza/$AltezzaPrevistaInPixel
: ($LarghezzaPrevistaInPixel>0)
$Coefficiente:=$Larghezza/$LarghezzaPrevistaInPixel
Else
$Coefficiente:=1
End case
$SizeOrizzontale:=($Larghezza/$Coefficiente
$SizeVerticale:=$Altezza/$Coefficiente
GET OBJECT RECT(*;$4;$left;$top;$right;$bottom)
MOVE OBJECT(*;$4;$left;$top;$SizeOrizzontale+$left;$SizeVerticale+$top;*)

Il metodo che segue permette di rendere maiuscole la prima lettera di un campo alfa e tutte quelle di tutte le altre parole della stringa, considerando come separatore di parola lo spazio.

      `$1 è il testo a cui applicare il metodo
      `$0 il risultato
C_STRING(30;$risultato_s;$0;$vch_s)
C_LONGINT($pos_l)
$risultato_s:=$1
$risultato_s:=Uppercase(Substring($risultato_s;1;1))+Lowercase(Substring($risultato_s;2;80))
$pos_l:=Position(" ";$risultato_s)
While ($pos_l>0)
    $vch_s:=" "+Substring($risultato_s;$pos_l+1;1)
    $risultato_s:=Replace string($risultato_s;$vch_s;Uppercase($vch_s);1)
    $pos_l:=Position(" ";$risultato_s;$pos_l+1)
End while

$0:=$risultato

I blob (Binary Large OBjects) sono tipi di dati, quindi campi o variabili, che possono contenere fino a 2GB di informazioni.

Per gestire blob di grosse dimensioni è possibile usare il comando Compress Blob con eventualmente 2 opzioni, per scegliere fra una maggiore compressione o una maggiore velocità. Ecco i due esempi:

COMPRESS BLOB(blob_blb;Compact compression mode)
COMPRESS BLOB(blob_blb;Fast compression mode)

Il comando per riportare il blob alle dimensioni originali è il seguente:
EXPAND BLOB(blob_blb)

Attenzione: se il blob contiene meno di 255 caratteri la compressione non ha luogo. Questo vuol dire che il successivo EXPAND BLOB potrebbe dare un errore. La modalità corretta di usarlo per evitare problemi è la seguente:

BLOB PROPERTIES(blob_blb;$compressione_l;$dim_espanso_l;$dim_corrente_l)
If ($compressione_l#Is not compressed)
  EXPAND BLOB(blob_blb)
End if

Il comando Num di 4D non riconosce come negativi i numeri passati racchiusi tra parentesi, mentre alcuni programmi come FileMaker o Excel possono utilizzare questo formato per l'esportazione di tali numeri, senza dunque la presenza del segno "-".
Ecco dunque un frammento di codice che consente di ottenere il numero corretto a partire da un testo passato come parametro:

C_TEXT($1;$tNumText_t)
C_REAL($0)
C_LONGINT($iLen:l)
$tNumText_t:=$1
$iLen_l:=Length($tNumText_t)

If ($tNumText_t[[1]]=Char(40)) & ($tNumText_t[[$iLen_l]]=Char(41))
        ` il numero è negativo
    $tNumText_t:=Replace string($tNumText_t;"(";"-")
    $tNumText_t:=Replace string($tNumText_t;")";"")
End if

$0:=Num($tNumText_t)

Ecco un metodo utilizzabile per calcolare il CRC per il protocollo industriale MODBUS.

Il CRC è un valore di 16 bit calcolato in base a tutti i byte che compongono il pacchetto (il parametro che riceve il metodo), a partire dal byte alto ed esclusi i byte del CRC. Se il CRC non è corretto la macchina slave ignora il pacchetto.

La procedura usa due array, arrHi e arrLow, dove sono memorizzati i valori necessari al calcolo del CRC.
Viene inoltre utilizzato il metodo u_EsadecimaleToDec il cui testo si trova nella faq Conversione da esadecimale a decimale.


$reg_Hi:=0x00FF
$reg_Low:=0x00FF
$test:=$1
C_STRING(80;$1;$0)
For ($i;1;Length($test);2)
  C_LONGINT($index)
  $deci:=u_EsadecimaleToDec ($test[[$i]]+$test[[$i+1]])
  $index:=$reg_Hi ^| $deci
  $reg_Hi:=$reg_Low ^| arrHi{$index+1}
  $reg_Low:=arrLow{$index+1}
End for
$risultatoA:=$reg_Hi << 8
$risultato:=$risultatoA ^| $reg_Low
$0:=Substring(String($risultato;"&x");3)


Il metodo di calcolo è utilizzabile anche per il calcolo del CRC del protocollo J-Bus.

(da un'idea di Massimo Giannessi)

Il problema si pone quando si installa un numero inferiore di licenze di Plug-in rispetto al numero di licenze 4D Client

con l'istruzione ' Is license available(4d view license) ' ritorna vero se ho almeno una licenza, ma non mi dice quante licenze sono già impegnate dai vari 4D client

` Procedura in StartUp
vErrView:=False
ON ERR CALL("ErrView")
QLV_StartUp
ON ERR CALL("")

` Procedura ErrView
vErrView:=True

` Procedura QLV_StartUp
`procedura che iniziallizza i component Italsoftware con plug-in 4D View

La variabile flag vErrView posso utilizzarla prima di fare le chiamate alle procedure che utilizzano i Plug-in (in questo caso di 4D View)

Alcune procedure eseguite su Client sarebbero eseguite in maniera molto più veloce su Server, ad esempio se si modificano tanti record e non ci sono legami all'interfaccia. Ora supponiamo di avere una procedura fatta così:

  `MioMetodo
  C_REAL($0;Tot_l)
  Tot_l:=0
  ALL RECORDS([Tabella])
  APPLY TO SELECTION([Tabella];Tot_l:=Tot_l+([Tabella]Prezzo*[Tabella]Quantità))
  $0:=Tot_l
  
Per evitare di modificare tutte le procedure che chiamano MioMetodo, interveniamo sullo stesso premettendo una chiamata a se stessa come stored procedure aggiungendo un parametro; poi aspettiamo il risultato dal server e lo ritorniamo come valore, mantenendo così invariato il funzionamento di MioMetodo dal punto di vista delle altre procedure.

  `MioMetodo
  C_REAL($0;Tot_l)
  C_TEXT($1;$Parametro_t)
  C_LONGINT($Processo_l)
  C_BOOLEAN(Pronto_b;HoLetto_b)
  
Case of
  : (Count parameters=0)
    $Processo_l:=Execute on server(Current method name;Maxint;Current method name;"SulServer")
    
    `Questo ciclo aspetta che la Stored Procedure sia Pronta a darmi il valore
    Pronto_b:=False
    Repeat
      DELAY PROCESS(Current process;60)
      IDLE
      GET PROCESS VARIABLE($Processo_l;Pronto_b;Pronto_b)
    Until (Pronto_b)
    GET PROCESS VARIABLE($I_Process;Tot_l;Tot_l)
    
    `E poi avverto la Stored Procedure che ho letto, così si chiude
    HoLetto_b:=True
    SET PROCESS VARIABLE($I_Process;HoLetto_b;HoLetto_b)
    
    `Ritorno il valore
    $0:=Tot_l

  Else
    `Questa parte viene eseguita sul server come Stored Procedure
    Pronto_b:=False
    
    `CODICE ORIGINALE
    Tot_l:=0
    ALL RECORDS([Tabella])
    APPLY TO SELECTION([Tabella];Tot_l:=Tot_l+([Tabella]Prezzo*[Tabella]Quantità))
    
    `avverto che il risultato è pronto
    Pronto_b:=True
    `aspetto che il client abbia letto e poi chiudo
    HoLetto_b:=False
    Repeat
      DELAY PROCESS(Current process;3)
      IDLE
    Until (HoLetto_b)
End case

Dalla versione 2004 il comando LAUNCH EXTERNAL PROCESS permette di eseguire applicativi esterni a 4D.
Nelle versioni precedenti si può usare il comando AP Sublaunch del plugin gratuito 4D Pack.

Ad esempio, è possibile cambiare i privilegi di accesso di un file usando il comando da Terminale su Mac:
LAUNCH EXTERNAL PROCESS ("chmod +x /cartella/documento")

Su Windows è possibile nascondere la finestra della Console DOS usando anche il comando SET ENVIRONMENT VARIABLE.

Ecco un esempio:
SET ENVIRONMENT VARIABLE("_4D_OPTION_CURRENT_DIRECTORY";"C:\\4D")
SET ENVIRONMENT VARIABLE("_4D_OPTION_HIDE_CONSOLE";"true")
LAUNCH EXTERNAL PROCESS("mycommand")

Ecco un esempio di uso di un paio di nuovi eventi introdotti nella versione 4D 2004.

Basta incollare questo codice nel metodo di un oggetto (di tipo testuale): quando ci si passa sopra con il mouse il testo contenuto viene evidenziato, un po' come quando con il browser si passa su un link.

Case of
  : (Form event=On Mouse Enter )
    FONT STYLE(Self->;Underline )

  : (Form event=On Mouse Leave )
    FONT STYLE(Self->;Plain )
End case

In 4D è possibile chiamare un metodo passando un certo numero di parametri non necessariamente prefissato.

I parametri all'interno del metodo vengono usati direttamente con la sintassi $1, $2, $3, etc o indirettamente con la sintassi ${num}: il metodo può sapere quanti parametri sono stati passati usando la funzion e Count parameter.
Il tipo dei parametri può essere comunque dichiarato usando la sintassi C_XXX(${n}) dove n indica che da quel parametro in poi sono tutti di tipo C_XXX.

Ecco un esempio di funzione che sfrutta queste caratteristiche:

` Metodo Massimo
` Massimo ( Valore { ; Valore2... ; ValoreN } ) -> ritorna il numero massimo
C_REAL ($0;${1}) ` Tutti i parametri sono dichiarati numeri Reali
$0:=${1}
For ($param_l;2;Count parameters)
  If (${$param_l}>$0)
    $0:=${$param_l}
  End if
End for

Quindi sono valide tutte le seguenti chiamate:
maggiore:= Massimo (numero1;numero2)
maggiore:= Massimo (n1;n2;n3;n4;n5;n6;n7;n8;n9;n10;n11;n12;n13;n14;n15;n16)
maggiore:= Massimo ((current date-$datanascita_1)/365,25;(current date-$datanascita_2)/365,25)

Usando l'evento On Before Keystroke si riesce ad intercettare cosa viene scritto nella corrente area di testo (dove si trova il cursore), prima che sia accettato come nuovo valore del campo o della variabile corrispondente.
Il metodo Handle keystroke utilizza una seconda variabile utilizzabile per gestire quello che si sta inserendo.
I parametri sono il puntatore all'area e il puntatore ad una variabile secondaria.
Il metodo ritorna il nuovo valore dell'area nella variabile e ritorna Vero se il testo è cambiato.

    ` Handle keystroke
    ` Handle keystroke ( Pointer ; Pointer ) -> Boolean
    ` Handle keystroke ( -> areaIns ; -> valoreCorrente ) -> E' un valore nuovo

C_POINTER ($1;$2)
C_TEXT ($nuovoValore_t)

GET HIGHLIGHT ($1->;$inizio_l;$fine_l) ` Prendi l'intervallo selezionato nell'area
$nuovoValore_t:=$2->` Inizia a lavorare con il valore corrente
    
Case of ` Controlla il tasto premuto
    ` E' stato premuto il tasto Backspace (Delete)
  : (Ascii (Keystroke)=Backspace )
    ` Cancella i caratteri selezionati o il carattere a sinistra
    $nuovoValore_t:=Substring ($nuovoValore_t;1;$inizio_l-1-Num($inizio_l=$fine_l))+Substring($nuovoValore_t;$fine_l)

    ` E' stato premuto un carattere accettato
  : (Position (Keystroke;"abcdefghjiklmnopqrstuvwxyz -0123456789")>0)
    If ($inizio_l#$fine_l)
      ` Se c'è una seleziona il carattere la sostituisce tutta
      $nuovoValore_t:=Substring($nuovoValore_t;1;$inizio_l-1)+Keystroke+Substring($nuovoValore_t;$fine_l)
    Else
      ` Non c'è selezione, solo il cursore...
        Case of
          ` .. all'inizio
          : ($inizio_l<=1)
           $nuovoValore_t:=Keystroke+$nuovoValore_t
           ` ... alla fine
          : ($inizio_l>=Length($nuovoValore_t))
           $nuovoValore_t:=$nuovoValore_t+Keystroke
          Else
           ` ... in mezzo al testo
           $nuovoValore_t:=Substring($nuovoValore_t;1;$inizio_l-1)+Keystroke+Substring($nuovoValore_t;$inizio_l)
          End case
        End if

        ` E' stata premuta una Freccia, accetta comunque il tasto
      : (Ascii(Keystroke)=Left Arrow Key )
      : (Ascii(Keystroke)=Right Arrow Key )
      : (Ascii(Keystroke)=Up Arrow Key )
      : (Ascii(Keystroke)=Down Arrow Key )
`
Else
    ` E' un carattere non accettato, lo filtra del tutto
  FILTER KEYSTROKE ("")
End case
    ` Il valore è cambiato?
$0:=($nuovoValore_t#$2->)
    ` Ritorna comunque il valore
$2->:=$nuovoValore_t

Clic qui per un esempio di utilizzo del metodo, per mascherare l'inserimento delle password

Ciao a tutti.

Voglio allegare nel backup del database anche la cartella MAC4DX
La cartella può contenere 2 tipi di plugin :
- come files con suffisso .4CX
- come pacchetti con suffisso .bundle

Il comando 'Select folder' ed il successivo comando 'DOCUMENT LIST' non permettono di riconoscere nella lista dei documenti contenuti i file con suffisso .bundle, che si comportano in realtà come delle cartelle. E' necessario per cui introdurre anche un successivo controllo sulle cartelle contenute nella cartella MAC4DX, con il comando 'FOLDER LIST'.

Per implementare il backup dell'intera cartella MAC4DX da un bottone 'Seleziona Cartella' inserito nella finestra di impostazioni del Backup è possibile utilizzare le seguenti 3 procedure:

Nel Bottone 'Seleziona Cartella':-------------------------------------------

C_TEXT($tPath)
ARRAY TEXT($aDocuments;0)

$tPath:=Select folder("Scegli una Cartella da allegare")

If ($tPath#"")
  DOCUMENT LIST($tPath;$aDocuments)
  FOLDER LIST($tPath;$aDirectories)
  For ($i;1;Size of array($aDocuments))
    If (Find in array(IncludesFiles;$tPath+BKP_GetDirGlyph +$aDocuments{$i})=-1)
      INSERT ELEMENT(IncludesFiles;Size of array(IncludesFiles)+1)
      IncludesFiles{Size of array(IncludesFiles)}:=$tPath+BKP_GetDirGlyph +$aDocuments{$i}
    End if
  End for

  If (Size of array($aDirectories)#0)
    For ($i;1;Size of array($aDirectories))
      BKP_XML_GetBundle ($tPath+BKP_GetDirGlyph +$aDirectories{$i})
    End for
  End if

End if

  ` Method: BKP_XML_GetBundle-------------------------------------------
$tPath:=$1
DOCUMENT LIST($tPath;$aDocuments)
FOLDER LIST($tPath;$aDirectories)
For ($i;1;Size of array($aDocuments))
  If (Find in array(IncludesFiles;$tPath+BKP_GetDirGlyph +$aDocuments{$i})=-1)
    INSERT ELEMENT(IncludesFiles;Size of array(IncludesFiles)+1)
    IncludesFiles{Size of array(IncludesFiles)}:=$tPath+BKP_GetDirGlyph +$aDocuments{$i}
  End if
End for

If (Size of array($aDirectories)#0)
  For ($i;1;Size of array($aDirectories))
    BKP_XML_GetBundle ($tPath+BKP_GetDirGlyph +$aDirectories{$i})
  End for
End if

  ` Method: BKP_GetDirGlyph-------------------------------------------
C_LONGINT($platform)
C_TEXT($0)

PLATFORM PROPERTIES($platform)
If ($platform=3)
  $0:="/"
Else
  $0:=":"
End if

(PROVATO SOLO SU MAC)

Ecco un esempio su come creare un quick report da programma:
1. viene creata un'area di appoggio offscreen (cioè non visibile all'utente)
2. viene impostata la tabella corrente
3. vengono inserite le colonne
4. si scelgono le colonne per l'ordinamento
5. si sceglie la destinazione, si esegue il Quick Report
6. si cancella l'area

Il codice stampa le colonne cognome e nome da una tabella Anagrafica e li ordina per cognome.

`Metodo: SempliceListaQR

C_LONGINT(mioQR)
mioQR:=QR New offscreen area ` 1
QR SET REPORT TABLE(mioQR;Table(->[Anagrafica])) ` 2
QR INSERT COLUMN(mioQR;1;->[Anagrafica]Cognome) `3, prima colonna
QR INSERT COLUMN(mioQR;2;->[Anagrafica]Nome) `3, seconda colonna
ARRAY REAL($colonne_ar;1) 4, preparo gli array
$colonne_ar{1}:=1 `4, ordina solo per la prima colonna
ARRAY REAL($ordinamento_ar;1)
$ordinamento_ar{1}:=-1 ` 4, -1 in ordine decrescente e 1 in ordine crescente.
QR SET SORTS(mioQR;$colonne_ar;$ordine_ar) ` 4
QR SET DESTINATION(mioQR;qr printer ) ` 5.
ALL RECORDS([Anagrafica]) ` 5.
QR RUN(mioQR) `5. questo esegue il report impostato!
QR DELETE OFFSCREEN AREA(mioQR) ` 6.

E' possibile capire il tipo di data utilizzato dal sistema su cui sta girando 4D usando questa unica riga di codice:

<>DateFormat:=Replace string(Replace string(Replace string(String(!10/20/99!;MM DD YYYY );"10";"M");"20";"D");"99";"Y")

Quando viene valutata su un computer che usa il sistema mese/giorno/anno, la variabile <>DateFormat conterrà il valore M/D/Y.
Eseguita su un computer che usi invece il sistema giorno/mese/anno, la variabile <>DateFormat conterrà il valore D/M/Y.
Si può usare un Case per gestire le possibilità.

Un sistema del genere è assai utili quando, ad esempio, risulta necessario inserire una costante di tipo data: possiamo determinare quindi se inserire 13/4/06 o 4/13/06.

Fonte: 4D Today

Il concetto base è che l'oggetto ListBox corrisponde ad un array di valori booleani che diventano veri se l'utente seleziona una o più righe.

Uno dei vantaggi delle list box è quello di consentire cancellazioni multiple in base alla selezione. Ecco il semplice metodo che le realizza:

`lbarray è il nome della List Box
C_LONGINT($pos)

$pos:=0
Repeat
      $pos:=Find in array(lbarray;True;$pos)
           If ($pos>0)
           DELETE LISTBOX ROW(*;"lbarray";$pos)
           $pos:=0
           End if
Until ($pos<0)

EAN13 è uno dei tipi di barcode più usati (il suo equivalente negli Stati Uniti è il codice UPC-A,che è un sottoinsieme di EAN13, ma dal 2005 i negozi americani devono accettare anche EAN13, eliminando di fatto la differenziazione).
Il tredicesimo carattere di un codice EAN13 è il codice di controllo del codice a barre, che viene calcolato utilizzando questo sistema:
- Si sommano le cifre del codice di posto pari
- Si aggiunge la somma delle cifre di posto dispari, ma moltiplicata per tre.
- Il checksum sarà il numero da aggiungere a questa somma per ottenere il primo multiplo di 10 immediatamente superiore.

Esprimiamo l'algoritmo di formato 4th Dimension:

$check:=0
For ($i;12;1;-1)
      If (($i/2)#($i\2))
           $check:=$check+(Num($String_to_encode[[$i]]))
      Else
           $check:=$check+(Num($String_to_encode[[$i]])*3)
      End if
End for

$check_S:=String($check)
$check:=10-Num(Substring($check_s;Length($check_s)))


Fonte: 4D Knowledgebase

Ecco un esempio di uso dei comandi Get First XML element e Get Next XML element per contare il numero di elementi di un file XML:

`Metodo ContaElementi
C_TEXT($1;$radice_t)
C_LONGINT($0;$2;$quanti_l)

$radice_t:=$1
$quanti_l:=$2+1

C_TEXT($subalterno_t)
$subalterno_t:=Get First XML element($radice_t)

While (OK=1)
    $quanti_l:=ContaElementi ($subalterno_t;$quanti_l) `chiamata ricorsiva
    $subalterno_t:=Get Next XML element($subalterno_t)
End while

$0:=$quanti_l

I comandi Windows Ctrl down e Macintosh control down permettono di controllare se il tasto Control viene premuto sulle due piattaforme, ritornando True se il tasto è premuto. Il problema è che se in un software Mac si usa Windows Ctrl down, ritornerà True solo se è premuto il tasto Command, mentre Macintosh control down su Win non ha equivalenti e dunque ritorna sempre False. Per effettuare un controllo corretto si può allora utilizzare questo metodo:

C_LONGINT($platform)
C_BOOLEAN($0)
PLATFORM PROPERTIES($platform)
If ($platform=3)
    $0:=Windows Ctrl down
Else
    $0:=Macintosh control down
End if

La conversione di un numero ottale in un decimale non è assai ricorrente, ma ecco comunque il metodo:

C_LONGINT($0;$decimal_l)
C_TEXT($1;$octal_t;$number_t;$octalStr_t)

$octalStr_t:=$1

$decimal_l:=0 `imposta un valore di ritorno

While (Length($octalStr_t)>0)
    $number_t:=Substring($octalStr_t;0;1)
    $octalStr_t:=Substring($octalStr_t;2)
    $decimal_l:=($decimal_l*8)+Num($number_t)
End while

$0:=$decimal_l

Ecco un semplice metodo per ricostruire gli indici:

READ WRITE(*)
C_POINTER($table;$field)
C_LONGINT($i;$j;$type;$length)
C_BOOLEAN($indexed)

For ($i;1;Count tables)
    $table:=Table($i)
    For ($j;1;Count fields($table))
        $field:=Field($i;$j)
        GET FIELD PROPERTIES($field;$type;$length;$indexed)
        If ($indexed)
           SET INDEX($field->;False)
           SET INDEX($field->;True)
           FLUSH BUFFERS
        End if
    End for
End for

Alcune annotazioni:
- il metodo dovrebbe essere eseguito senza che altri utenti siano connessi e senza che se ne possano connettere prima del suo completamento;
- è possibile che la reindicizzazione necessiti di molto tempo;
- le subtable devono essere indicizzate a parte.

Se la reindicizzazione non andasse a buon fine, bisogna controllare quale campo comporta tale problema. Si potrebbe, ad esempio, prima della reindicizzazione di ogni campo, scrivere in un file su quali campi stiamo agendo, in modo da poter sapere quale dato ha portato al crash.

4D 2003 introduce un set di comandi XML per scorrere la gerarchia "DOM" di un documento XML. Per trovare un elemento specifico occorre ciclare su tutti i nodi, e identificare i songoli elementi uno per uno.

In 4D 2004, il nuovo comando DOM Find XML element permette di trovare l'elemento usando la notazione XPath. Per esempio, poniamodi avere un documento XML con questa struttura:
<a>
  <b>
    <c>
      <d/>
      <e/>
    </c>
  </b>
</a>

Per trovare l'elemento "b" basterà scrivere:
$a:=DOM Parse XML source("mio.xml")
$b:=DOM Find XML element($a;"/a/b")

Allo stesso modo, per trovare l'elemento "e" a partire dall'elemento "a":
$e:=DOM Find XML element($a;"/a/b/c/e")

Oppure partendo dall'elemento "b":
$e:=DOM Find XML element($b;"/b/c/e")

Nella 4D 2004, è stato introdotto il comando LAUNCH EXTERNAL PROCESS per eseguire applicazioni esterne in un processo separato e distinto da quello di 4d.

Su Windows, appare una finestra di terminale quando lanci un applicativo basato sulla console.
Nella 2004.1, il comando SET ENVIRONMENT VARIABLE è stato aggiornato per nascondere la finestra. Ecco come:

SET ENVIRONMENT VARIABLE("_4D_OPTION_HIDE_CONSOLE";"True")
LAUNCH EXTERNAL PROCESS("dir.exe";$input;$output)

Per rivedere la finestra basta lanciare di nuovo un LAUNCH EXTERNAL PROCESS senza il comando SET ENVIRONMENT VARIABLE o impostandolo a "False."

Solitamente l'utente che si vede davanti una finestra di Request che gli chieda l'inserimento di una data è costretto ad inserire 6,8,10 caratteri (con i separatori), con conseguente perdita di tempo, soprattutto se la data da inserire è (relativamente alla data attuale) sempre la stessa: se, ad esempio, l'utente inserisce solitamente la data di inizio del mese corrente o della settimana corrente, possiamo generare delle scorciatoie per avere un vantaggio dalla possibilità di inserire una stringa.
Ecco allora un metodo che gestisce una serie di scorciatoie da tastiera per le date. Le scorciatoie sono:

1) M : la prima data del mese
2) U : l'ultima data del mese
3) A : il primo giorno dell'anno
4) F : l'ultimo giorno dell'anno
5) L : il primo giorno della settimana
6) D : l'ultimo giorno della settimana
7) + : domani
8) - : ieri
9) O : oggi
10) Se l'utente inserisce un numero, viene ritornata la data con il mese e l'anno correnti
11) Se l'utente inserisce un numero, un separatore e un numero, viene ritornata la data con l'anno corrente
12) Altrimenti viene ritornato il risultato della funzione "Date" di 4th Dimension.

Ecco il metodo.


C_TEXT($1)
C_DATE($0)

$currentMonthString_S:=String(Month of(Current date(*)))
$currentYearString_S:=String(Year of(Current date(*)))
$firstDateOfThisMonth_D:=Date("01/"+$currentMonthString_S+"/"+$currentYearString_S)

Case of
    : ($1="O") ` oggi
        $0:=Current date(*)

    : ($1="A") ` primo giorno dell'anno
        $0:=Date("01/01/"+$currentYearString_S)

    : ($1="F") ` ultimo giorno dell'anno
        $0:=Date("31/12/"+$currentYearString_S)

    : ($1="M") ` primo giorno del mese
        $0:=$firstDateOfThisMonth_D

    : ($1="U") ` ultimo giorno del mese
        $0:=Add to date($firstDateOfThisMonth_D;0;1;-1)
           ` ho aggiunto un mese e tolto un giorno

    : ($1="L") ` primo giorno della settimena. Lunedì
        $data_D:=Current date(*)
        $miogiorno_L:=((Day number($data_D))-1)+(7*(Num(((Day number($data_D))=1)))
        $0:=Current date(*)-($miogiorno_L-1)
        `se si vuole Domenica usare direttamente
        `$0:=Current date(*)-(Day number(Current date(*))-1)

    : ($1="D") ` ultimo giorno della settimana. Domenica.
        $data_D:=Current date(*)
        $miogiorno_L:=((Day number($data_D))-1)+(7*(Num(((Day number($data_D))=1)))
        $0:=Current date(*)+(7-$miogiorno_L)
      ` se si vuole Sabato usare direttamente
      ` $0:=Current date(*)+(7-Day number(Current date(*)))

    : ($1="+") `domani
        $0:=Current date(*)+1
    : ($1="-") `ieri
        $0:=Current date(*)-1
    Else `nessuno dei casi precedenti
        $testDate_D:=Date($1)
        If ($testDate_D=!00/00/00!) `se non è una data completa la riempio io
           $1:=$1+"/"+$currentYearString_S
           $testDate_D:=Date($1)
           If ($testDate=!00/00/00!)
           $1:=$1+"/"+$currentMonthString_S+"/"+$currentYearString_S
           $testDate_D:=Date($1)
           End if ` ($testDate_D=!00/00/00!)
        End if ` ($testDate_D=!00/00/00!)
        $0:=$testDate_D
End case

Per conoscere il tipo di un'immagine in un documento o in un blob è possibile usare questo comando del plugin 4D Pack:

AP Get Picture type (Blob_immagine) -> longint

Il valore ritornato sarà:

-1 Sconosciuto
0 immagine 'PICT'
1 immagine 'PICT' compressa con QuickTime
2 immagine JPEG
3 immagine WMF
4 immagine EMF
5 immagine BMP
6 immagine GIF

Esempio:
DOCUMENT TO BLOB($nomeDocumento_t;$immagine_blb)
$tipo_l:=AP Get picture type($immagine_blb)

Il comando AP Sublaunch del 4D Pack permette di eseguire una azione di sistema sotto Windows. Possiamo utilizzarlo quindi anche per aprire, ad esempio, finestre del pannello di controllo di Windows.

Per aprire il pannello di controllo:

$String_t:="rundll32 shell32.dll,Control_RunDLL"
$lErr:=AP Sublaunch ($String_t;0)

Per aprire una voce specifica del pannello di controllo, ad esempio il pannello di controllo dell'origine dei dati ODBC:

$String_t:="rundll32 shell32.dll,Control_RunDLL odbccp32.cpl"
$lErr:=AP Sublaunch ($String_t;0)


Alcune voci del pannello di controllo contengono più pagine, selezionabili attraverso un tab control. Possiamo anche da linguaggio specificare quale pagina aprire. Con l'esempio che segue viene aperta la pagina screen saver delle proprietà dello schermo:

$String_t:="rundll32 shell32.dll,Control_RunDLL desk.cpl,,1"
$lErr:=AP Sublaunch ($String_t;0)


Fonte: Jeffrey Kain, 4D Today

Nel 4D Pack della 2004.1 c'è un nuovo comando AP Create Method che permette di creare un nuovo metodo in un database interpretato.

La sintassi è la seguente:
codice_errore:=AP Create Method(NomeMetodo;arrayAttributi;blobCodice;nomeCartella)

Ecco un esempio:
C_LONGINT($err_l)
C_TEXT($nomeMetodo_t;$nomeCartella_t)
ARRAY LONGINT($attributi_al;4)
C_BLOB($codice_blb)
$nomeMetodo_t:="Mio Nuovo Metodo"
TEXT TO BLOB("ALERT(\"Ciao\")";$codice_blb;Text without length;*)
$attributi_al{1}:=1 ` è usabile come 4D action?
$attributi_al{2}:=1 ` è invisible?
$attributi_al{3}:=1 ` è usabile da soap?
$attributi_al{4}:=1 ` è pubblicato nel wsdl?
$nomeCartella_t:="Default Folder"
$err_l:=AP Create method($nomeMetodo_t;$attributi_al;$codice_blb;$nomeCartella_t)

err_l contiene 0 se è andato bene e -1 se c'è stato un errore. Da ricordarsi che funziona solo su database interpretati, non compilati.

Quando si vuole essere certi che una certa operazione sia eseguita senza contemporaneità è possibile usare la funzione Semaphore.

Questa funziona permette di testare se un semaforo esiste già (ritorna TRUE) oppure lo crea (e ritorna FALSE). Eseguite le sue operazioni lo si cancella con Clear Semaphore.

Ecco un esempio di codice per usarlo:

If (Semaphore("ModificaDelListinoPrezzi")) ` Provo a creare il semaforo
  ALERT("Qualcun altro sta già modificando i prezzi. Riprova più tardi.")
Else
  ` Metti qui il codice che devi eseguire
  CLEAR SEMAPHORE("ModificaDelListinoPrezzi")) ` Non mi serve più
End if

Oppure per una modifica che coinvolge operazioni di breve durata, faccio aspettare la mia richiesta finché non si libera il posto:

C_Boolean($Fatto_b)
$Fatto_b:=False
While ($Not($Fatto_b))
  If (Semaphore("RegistroNumFattura"))
    IDLE
  Else
    ' Metti qui il codice che devi eseguire
    CLEAR SEMAPHORE("RegistroNumFattura")
    $Fatto_b:=True
  End if
End while

Le comunicazioni attraverso le porte seriali tipo RS 232, RS 422 o RS 485 sia in trasmissione che in ricezione possono essere gestite dallo stesso metodo. Eccone un esempio.
Utilizzaremo le seguenti variabili:

<>Port è la porta da usare per la trasmissione/ricezione.

<>Param sono le impostazioni della porta seriale (velocità, data bit, etc.).

<>In_Out: controlla l'esecuzione del While.

<>vTransmit è la stringa da trasmettere.

<>tPages è un array testo per gestire ricezioni maggiori di 30.000 caratteri.

Ecco il metodo:

C_TEXT($vRecept)
C_TEXT($ReadMem)

ARRAY TEXT(<>tPages;1)
<>PageNumber:=1

SET CHANNEL(<>Port;<>Param)
SET TIMEOUT(<>Time_Out)
<>In_Out:=True

While (<>In_Out)
      RECEIVE BUFFER($vRecept)

      Case of
           : ($vRecept#"")  ` dati ricevuti
           $ReadMem:=$ReadMem+$vRecept
           <>ReadVar:=<>ReadVar+$vRecept
           <>LongVarRead:=Length(<>ReadVar)

           If (Length($ReadMem)>30000)
           <>tPages{<>PageNumber}:=$ReadMem
           $ReadMem:=""
           <>ReadVar:=""
           <>PageNumber:=<>PageNumber+1
           CALL PROCESS(1)
           INSERT ELEMENT(<>tPages;Size of array(<>tPages)+1)
           End if

           CALL PROCESS(-1)

           : (<>vTransmit#"")  ` trasmissione dati
           BEEP
           SEND PACKET(<>vTransmit+Char(13))
           <>vTransmit:=""
           CALL PROCESS(-1)

      End case

      DELAY PROCESS(Current process;30)
End while

SET CHANNEL(11)


In caso di alti flussi di dati potrebbe essere necessario ridurre il tempo di pausa inserito nella riga:

DELAY PROCESS(Current process;30)

Ecco un metodo semplice per anticipare cosa sta scrivendo l'utente in un campo testo, ipotizzando che il contenuto possa già trovarsi in una tabella a disposizione: ad esempio, per fare un filtro su una sottolista o per suggerire un termine già inserito o un termine fra una lista definita.

Dato un oggetto parola_t, bisogna attivare l'evento "on after keystroke": da considerare che questo è chiamato prima di uscire dal campo, quando la variabile parola_t non contiene niente; per questo prendiamo il valore con la funzione "get edited text"

If (Form event=On After Keystroke)
  caratteri_t:=Get edited text
  If (caratteri_t#"")
    QUERY([Tabella];[Tabella]ParolaChiave = caratteri_t +"@")
    SELECTION TO ARRAY([Tabella]ParolaChiave; listaParole_at)
    UNLOAD RECORD([Tabella])
  Else
    REDUCE SELECTION([Tabella];0)
    ARRAY STRING(50;listaParole_at;0)
  End if
End if

Una soluzione al problema è quella di utilizzare i comandi IMPORT DATA e EXPORT DATA. Prima però è necessario creare un progetto di import/export in questo modo:

- aprire l'editor di import/export;
- scegliere i campi;
- scegliere se esportare tutto o la selezione (meglio la selezione, non si sa mai);
- nella sezione "Format" scegliere 4th Dimension;
- salvare il progetto cliccando sul pulsante di salvataggio delle impostazioni ("Save settings") nella stessa cartella della struttura (nel nostro esempio supporremo di aver salvato il progetto col nome "IEProject");
- premere "Cancel" per uscire.

A questo punto, i due metodi che seguono permettono importazione ed esportazione dei dati:

`Metodo: Import
C_BLOB($bProject)
DOCUMENT TO BLOB("IEProject";$bProject) `Carica l'Import/Export Setting
IMPORT DATA("FileName";$bProject)

`Metodo: Export
C_BLOB($bProject)
DOCUMENT TO BLOB("IEProject";$bProject) `Sempre Carica
EXPORT DATA("FileName";$bProject)

Se capita di dover sviluppare un programma 4D che abbia come dati quelli presenti in archivi DBF, quando viene eseguita l'importazione degli archivi DBF i dati di tipo stringa contengono degli spazi finali inutili. Una tecnica per risolvere il problema è eseguire il presente codice di correzione:

For ($tableNum_l;11;20) `se, ad esempio, le prime 10 tabelle non sono importate
      For ($campoNum_l;1;Count fields($tableNum_l))
           GET FIELD PROPERTIES($tableNum_l;$campoNum_l;$tipoCampo_l)
           If ($tipoCampo_l =0)
           $table_ptr:=Table($tableNum_l)
           ALL RECORDS($table_ptr->)
           $campo_ptr:=Field($tableNum_l;$campoNum_l)
           APPLY TO SELECTION($table_ptr->;$campo_ptr->:=EliminaSpazi ($campo_ptr->))
           End if
      End for
End for

Il metodo EliminaSpazi si trova in questa faq.

Poniamo di avere una stringa nella forma "http://www.sviluppo4d.it?arg=1&arg2=2&arg3=3". Questa stringa è facilmente spezzata in due array di nomi e valori corrispondenti con il comando GET WEB FORM VARIABLES.

Ma in alcuni casi, per risparmiare spazio nella stringa (gli URL sono limitati a 255 caratteri) la stringa potrebbe essere del tipo "http://www.sviluppo4d.it?parametro1=500&miocomando", cioè potrebbe mancare il valore con il suo "=".

In questo caso si può usare questo metodo, che accetta come parametri la stringa e il puntatore dei due array, dei nomi e dei valori.

`Metodo: EstraiNomiEValori

C_TEXT($1;$testoParametri_t;$stringa_t)
C_POINTER($2;$Nomi_ptr)
C_POINTER($3;$Valori_ptr)
C_TEXT($sinistra_t;$destra_t)

$testoParametri_t:=$1
$Nomi_ptr:=$2
$Valori_ptr:=$3

    ` se troviamo un'altra & nella stringa la gestiamo richiamndo lo stesso metodo
If (Position("&";$testoParametri_t)#0)
    $stringa_t:=Substring($testoParametri_t;0;Position("&";$testoParametri_t)-1)
    $testoParametri_t:=Substring($testoParametri_t;Position("&";$testoParametri_t)+1)
    EstraiNomiEValori($testoParametri_t;$Nomi_ptr;$Valori_ptr)
Else
    $stringa_t:=$testoParametri_t
End if

    ` Qui inizia il lavoro vero e proprio
If (Length($stringa_t)>0)
    ` controlla se si tratta di un assegnamento normale o solo di un nome
    If (Position("=";$stringa_t)#0)
        $sinistra_t:=Substring($stringa_t;0;Position("=";$stringa_t)-1)   ` parte sinistra
        $destra_t:=Substring($stringa_t;Position("=";$stringa_t)+1)   ` parte destra
    Else
        $sinistra_t:=$stringa_t   ` solo la parte sinistra, senza la parte destra
    End if

    INSERT ELEMENT($Nomi_ptr->;1)
    INSERT ELEMENT($Valori_ptr->;1)

    $Nomi_ptr->{1}:=$sinistra_t
    $Valori_ptr->{1}:=$destra_t
End if

Ecco una metodo semplice per gestire lo spostamento di una sottolista all'interno di una lista Gerarchica. L'oggetto che contiene la lista gerarchica avrà questo codice:

If (Form event=On Drop )
        SpostaSottolista(Self->)
        REDRAW LIST(Self->)
End if

Ed ecco il codice del metodo SpostaSottolista:

C_LONGINT($1;$Lista_l)
C_LONGINT($oggettoOrig_l;$elementoOrig_l;$processoOrig_l)
C_LONGINT($riferimentoOrig_l;$riferimentoDest_l;$sottolista_l)
C_TEXT($testoOrig_t;$testoDest_t)
C_BOOLEAN($aperta)
$Lista_l:=$1

  `prendo i dati della posizione di partenza e di quella di arrivo
DRAG AND DROP PROPERTIES($oggettoOrig_l;$elementoOrig_l;$processoOrig_l)
GET LIST ITEM($Lista_l;$elementoOrig_l;$riferimentoOrig_l;$testoOrig_t;$sottolista_l;$aperta_b)
GET LIST ITEM($Lista_l;Drop position;$riferimentoDest_l;$testoDest_t)

  `cancello la partenza e inserisco i dati nella posizione di arrivo
DELETE LIST ITEM($Lista_l;$riferimentoOrig_l)
INSERT LIST ITEM($Lista_l;$riferimentoDest_l;$testoOrig_t;$riferimentoOrig_l;$sottolista_l;$aperta_b)

La funzione Count tasks ritorna il numero totale dei processi che sono stati aperti in un'applicazione 4D, inclusi i processi ormai chiusi. Ecco una semplice procedura che riempie due array con i nomi e i corrispondenti numeri dei processi attivi: la regola che usa è che lo stato del processo è 0 se in esecuzione, positivo se in pausa o in qualche altro stato di attesa, negativo se non esiste o se ha finito.

C_LONGINT($quantiProcessi_l;$quantiAttivi_l;$processo_l;$stato_l;$tempo_l)
$quantiProcessi_l:=Count tasks

ARRAY STRING(31;procNomi_at;$quantiProcessi_l)
ARRAY INTEGER(procNum_al;$quantiProcessi_l)
$quantiAttivi_l:=0
For ($processo_l;1;$quantiProcessi_l)
    If (Process state($processo_l)>=Executing )
        $quantiAttivi_l:=$quantiAttivi_l +1
        PROCESS PROPERTIES($processo_l;$procNomi_at{$quantiAttivi_l};$stato_l;$tempo_l)
        $procNum_al{$quantiAttivi_l}:=$processo_l
    End if
End for
ARRAY STRING(31;$procNomi_at;$quantiAttivi_l)
ARRAY INTEGER($procNum_al;$quantiAttivi_l)

  `Nome Methodo: BLOB_to_Text_Array
    `Descrizione: Riempe un array di testo con i dati contenuti in un BLOB
    `Parametro: $0 ritorna il numero di elementi creati nell'array
    `Parametro: $1 è un puntatore ad una variabile di tipo BLOB
    `Parametro: $2 è un puntatore ad una variabile di tipo Text Array (da riempire)

C_POINTER($1;$2)
C_LONGINT($dimBlob_l;$dimRiga_l;$dove_l;$0)

$dimRiga_l:=20000  ` dimensione di ogni blocco di testo (massimo è 32000)
$dove_l:=0
$dimBlob_l:=BLOB size($1->)

Repeat
  APPEND TO ARRAY($2->;BLOB to text($1->;Text without length ;$dove_l;$dimRiga_l))
Until ($dimBlob_l<=$dove_l)

$0:=Size of array($2->)  ` ritorna il numero di elementi aggiunti

4D fa passare nelle liste di output solo i campi visibili, a meno che non ci sia uno script che richieda un campo che nella prima riga non c’era: a quel punto 4D carica tutti i campi del record. Questo può essere un problema se la tabella ha molti campi o se contiene un campo con un'immagine o un blob.

Soluzione: basta caricare in ogni riga, al display detail, tutti i campi che servono anche quando non li si usa. In questo modo la lista è nettamente più efficiente.

Ad esempio, se nella lista c'è un codice così:

:(form event=on display detail)
  vTaglia:=[Animale]Altezza
  If ([Animale]Razza=”Pachiderma”)
    vTaglia:=[Animale]Peso
  End if

Basta scriverlo in questo modo

:(form event=on display detail)
  vTaglia:=[Animale]Altezza
  $campoPeso:=[Animale]Peso
  If ([Animale]Razza=”Pachiderma”)
    vTaglia:=$campoPeso
  End if

In questo modo 4d può già dalla prima riga mettere in conto quali sono i soli campi necessari a mostrare la lista.

Supponiamo di avere il seguente problema: voler utilizzare il tasto "Canc" del tastierino numerico come "." e non come "," per ottenere un input da tastiera del tipo "ABC.123.456" invece di "ABC,123,456".
La soluzione è utilizzare i comandi che permettono di intercettare l'inserimento da tastiera da parte dell'utente:

- il comando Keystroke restituisce in una stringa il carattere inserito dall'utente;
- il comando FILTER KEYSTROKE prende come parametro una stringa e sostituisce il testo inserito dall'utente col primo carattere della stringa passata come parametro;
- il form event On Before Keystroke che si attiva quando l'utente "sta per digitare" qualcosa sulla tastiera.

Mettendo insieme tutte queste informazioni il codice diventa:

Case of
      :(Form event=On Load )
           myObject_s:=""
      :(Form event=On Before Keystroke)
           If (Position(Keystroke;",")>0)
           FILTER KEYSTROKE(".")
           End if
End case


Per altre possibilità per intercettare l'input dell'utente è possibile vedere anche questa faq

Nota UM: Dalla 6.8 è disponibile il comando Quit che rende obosleta questa Faq, ma il metodo utilizzato (Post Key) è interessante e utilizzabile in qualche altro caso.

Ecco un metodo che permette di eseguire l'uscita da un 4D Server direttamente da 4D Client, senza dover quindi accere alla macchina dove il Server è installato: l'unico parametro utilizzato è il tempo di attesa che si vuole date al Server prima di chiudersi.

C_INTEGER($1)
    `
C_STRING(11;$attesa_stringa) ` tempo di attesa come stringa
C_INTEGER($I_Attesa;$I_ProcessNum;$i)
C_BOOLEAN($B_WaitingUserDisconn) ` True = wait attende l’uscita
    `
    `
Case of
      ` su 4D Client, lanciamo lo stesso metodo, ma come Stored procedure
  : (Application type=4D Client )
  $I_Attesa:=-2 ` -2 means "Default 4D Server's value" (see below)
  If (Count parameters#0)
    $I_Attesa:=$1
  End if
  $I_ProcessNum:=Execute on server(Current method name;32*1024;Current method name;$I_Attesa)
      `
      ` su Server generiamo un Command o Ctrl - Q
  : (Application type=4D Server )
  $B_WaitingUserDisconn:=False
  $attesa_stringa:=""
  Case of
    : (Count parameters=0) ` possibile se chiamato altrove
    : ($1<0) ` se negativo usa l’opzione di default
    $B_WaitingUserDisconn:=($1=-1) ` cioè attendo l’uscita
  Else
    $attesa_stringa:=String($1) ` per fare in modo che la cifra venga scritta con POST KEY
  End case
      `
      ` Mando l’evento al processo numero 1.
  POST KEY(Ascii("q");Command key mask ;1)
      ` attendo che compaia la finestra
  DELAY PROCESS(Current process;60)
      ` scrivo il numero per l’attesa
      ` e se la stringa è vuota non entra
  For ($i;1;Length($attesa_stringa))
    POST KEY(Ascii($attesa_stringa[[$i]]);0;1)
    DELAY PROCESS(Current process;10)
  End for
      ` passiamo dopo
  POST KEY(9;0;1)
  DELAY PROCESS(Current process;10)
      ` se richiesto, spuntiamo WaiUser
  If ($B_WaitingUserDisconn)
    POST KEY(US ASCII code ;0;1)
    DELAY PROCESS(Current process;10)
  End if
      ` Conferma ed esce
  POST KEY(13;0;1)
End case

Ecco un metodo "brutale" per cercare una stringa all'interno di un BLOB. Il metodo riceve come parametri un puntatore al BLOB, la stringa da cercare e la posizione da cui partire con la ricerca, e ritorna la posizione, altrimenti -1.


C_LONGINT($0;$3;$Start)
C_POINTER($1)
C_TEXT($2)
C_BOOLEAN($match)
$0:=-1
$Start:=$3
TEXT TO BLOB($2;$blob;Text without length )
$l:=BLOB size($1->)-1
$ll:=BLOB size($blob)-1
For ($i;$Start;$l)
    If ($1->{$i}=$blob{0})
        $match:=True
        For ($ii;0;$ll)
           If ($1->{$i+$ii}#$blob{$ii})
           $match:=False
           $ii:=$l
           End if
        End for
    End if
    If ($match)
        $0:=$i
        $i:=$l
    End if
End for


Fonte: 4DToday - Patrick Marty

Supponiamo di voler conoscere lo stato di una base dati remota, alla quale non possiamo accedere direttamente. Il seguente metodo, usando semplicemente il comando SEND PACKET, permette di costruire un file testo separato da tabulazioni (quindi apribile ad esempio con Excel) sullo stato della base dati da qualsiasi client. Nel'esempio che riporto vogliamo conoscere lo stato dei data segment e il numero di record delle tabelle.

$DocRef:=Create document("")

If (ok=1)
      `Intestazioni
      $Text:="Segment Size"+Char(Tab )+"Percorso"+Char(Carriage return )+Char(Carriage return )
      SEND PACKET($DocRef;$Text)
      `trovo i segmenti

      ARRAY TEXT(text_Segments;0)
      DATA SEGMENT LIST(text_Segments)

      `scrivo per ogni segmento dimensione del file e percorso

      For ($Segment;1;Size of array(text_Segments))
           $Size:=Get document size(text_Segments{$Segment})
           $Text:=String($Size;"#,###,###,##0")+Char(Tab )+text_Segments{$Segment}+Char(Carriage return )
           SEND PACKET($DocRef;$Text)
      End for

      `una linea vuota

      $Text:=Char(Carriage return )
      SEND PACKET($DocRef;$Text)

      `ancora intestazioni...

      $Text:="Table #"+Char(Tab )+"Table Name"+Char(Tab )+"Records"+Char(Tab )+"Cancellati"+Char(Tab )+"Frag%"+Char(Carriage return )+Char(Carriage return )
      SEND PACKET($DocRef;$Text)

      `ciclo su ogni tabella

      For ($Table;1;Count tables)

           $Recs:=Records in table((Table($Table))->)
           $Max:=Sequence number((Table($Table))->)
           $Deletions:=($Max-1)-$Recs
           $Frag:=($Deletions/$Recs)*100  `Expressed as a percentage

           $Text:=String($Table)+Char(Tab )+Table name($Table)+Char(Tab )+String($Recs)+Char(Tab )+String($Deletions)+Char(Tab )+String($Frag)+Char(Carriage return )

           SEND PACKET($DocRef;$Text)

      End for

      CLOSE DOCUMENT($DocRef)

End if

Analizzando il DOM di un XML può essere necessario ottenere l'attributo per un certo insieme di elementi: il problema è che un certo attributo può non essere presente in tutti gli elementi. Ad esempio:


  Modica
  Ragusa


Se si usa il comando GET ATTRIBUTE BY NAME e l'attributo non esiste, verrà restituito un errore. Può essere allora interessante usare GET ATTRIBUTE BY INDEX per evitare di ottenere l'errore:


` Parametri
    ` $1 - il nodo dell'elemento per cui trovare l'attributo
    ` $2 - il nome dell'attributo che stiamo cercando
    ` $0 - il valore dell'attributo o stringa vuota se non trovato
    ` ----------------------------------------------------
C_TEXT($1;$2)

C_TEXT($elemRef)
$elemRef:=$1

C_TEXT($searchName)
$searchName:=$2

C_LONGINT($i;$attribCount)
C_TEXT($attribName;$attribValue)
$attribCount:=Count XML attributes($elemRef)

  ` cerca l'attributo finché non viene trovato
For ($i;1;$attribCount)
  GET XML ATTRIBUTE BY INDEX($elemRef;$i;$attribName;$attribValue)
  If ($attribName=$searchName)
      ` esco dal ciclo
      $i:=$attribCount+3
  End if
End for

  ` ritorna attribValue (che potrebbe anche essere vuoto)
$0:=$attribValue