Sviluppo4d.it
Sito indipendente di informazioni tecniche per sviluppatori 4th Dimension italiani  

Sviluppatori 4D

Utility 4D

Risorse 4D



4d logo
Naviga:

Faq

Ho trovato 199 faq.

Categoria Argomento Commenti
Codice Codice Convertire numeri arabi in numeri romani
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

Codice Codice Check Digit Ean13/Ean8
// 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)
Codice Codice Numeri a lettere
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)
Codice Codice Controllo Codice Fiscale
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
3
Codice Codice Calcolo del codice fiscale
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

Codice Codice Cercafield : Query veloce lookup
// 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}
Codice Codice Interaleave 2of5 codice per ottenere binario del codice
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

Codice Codice Ean2Bin
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
Codice Codice Sconti composti
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
Codice Codice Percorso della cartella Documenti
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
Codice Codice Come creare una plist per Mac OS X o IOS
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
1
Codice Codice Ruotare un'immagine usando SVG
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
1
Codice Codice InStrRev trova la prima posizione di una stringa partendo dalla fine
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.
Codice Codice Creare un file di testi UTF-8 con BOM
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
Codice Codice Metodo alternativo per riempire una Popup Drop Down List
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

Codice Codice Data e ora in formato XML
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))

1
Codice Codice Copiare negli appunti il contenuto di una listbox
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.
Codice Codice Estrarre tutti gli URL da un testo
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))
Codice Codice Ottenere la lista di tutte le relazioni di un database
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
Codice Codice Spostare i dati di una tabella in un database esterno
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
Codice Codice Stampare una Rich Text Area
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
Codice Codice Modificare la cella di una listbox con un solo clic
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


1
Codice Codice Usare Match Regex per estrarre i numeri da un indirizzo IP
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
Codice Codice [v12] Ricevere mail dal server POP di GMail
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)

Codice Codice [v12] Ricevere mail dal server IMAP di GMail
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)

Codice Codice [v12] Inviare mail utilizzando il server SMTP di GMail
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)
Codice Codice Come sapere il giorno in cui cade Pasqua per un certo anno
// ----------------------------------------------------
    // 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
Codice Codice Ottenere info sulla memoria
  ` ----------------------------------------------------
    ` 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
Codice Codice Esportazione della struttura usando _USER_COLUMNS
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)
Codice Codice Esempio di uso di SVG
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)
Codice Codice [v12] Carattere di separazione fra cartelle
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
Codice Codice Metodo EliminaSpazi con Match Regex
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
1
Codice Codice [v11 SQL] Esportazione dati
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)
Codice Codice Conversione da esadecimale a decimale
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



2
Codice Codice Come usare le transazioni nelle maschere di inserimento V2
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.
1
Codice Codice Come usare le transazioni nelle maschere di inserimento
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
Codice Codice PDO_4D: il codice PHP per l'inserimento di dati
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
           )

)
Codice Codice Confrontare il contenuto di due dischi o due cartelle
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
Codice Codice Esportazione dati in formato testo
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
Codice Codice Un termometro con incremento corretto
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.

Codice Codice Il numero di giorno nell'anno
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
Codice Codice [v11 SQL] Caricare una lista in un array
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
Codice Codice Filtro caratteri da non utilizzare in un URL
`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

Codice Codice Generazione del file Sitemap.xml con i comandi XML DOM di 4d
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)

Codice Codice Generazione automatica del file Sitemap.xml
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)
1
Codice Codice Generazione automatica del file Robots.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)


Codice Codice Calcolo del numero della settimana (2)
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))
3
Codice Codice Metodo EliminaSpazi *
  `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.
Codice Codice Caricare gli indici all'avvio
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
Codice Codice Numeri da cifre a lettere
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

1
Codice Codice Quando non riesco a cambiare stampante con SET CURRENT PRINTER
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.
Codice Codice [v11 SQL] Elenco dei 4D server aperti con i nuovi comandi UDP
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)

Codice Codice [v11 SQL] Ottenere l'MD5 di un file con AP Get file MD5 digest
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)

Codice Codice [v11 SQL] Scegliere il tipo di indici
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
Codice Codice [v11 SQL] Requisiti minimi
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
Codice Codice [v11 SQL] Cercare duplicati usando il codice SQL
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.
Codice Codice [v11 SQL] Passaggio di parametri ai comandi SQL
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
Codice Codice [v11 SQL] Dove si trova l'insider?
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

Codice Codice [v11 SQL] Campi testo, BLOB e immagini
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ù.
Codice Codice [v11 SQL] Informazioni sugli oggetti delle form
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.
Codice Codice [v11 SQL] Nuove proprietà delle ListBox
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.
Codice Codice [v11 SQL] Ricerca per parola chiave
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.
Codice Codice Ingrandire un'immagine in una variabile
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%

Codice Codice Contare le parole di un testo
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


2
Codice Codice Print one job (Print Record+ Print form)
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)
Codice Codice Integrare Ajax Framework con una gestione web esistente
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

Codice Codice Un file col contenuto della cartella
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
Codice Codice Bloccare record multipli di una tabella in un processo
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.
Codice Codice Effettare una chiamata con Skype da 4D
E' possibile, direttamente da 4th Dimension, effettuare una chiamata con Skype utilizzando molto semplicemente la sintassi:

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

Codice Codice Svuotare velocemente gli array di testo su Windows
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".
Codice Codice Tutti i valori di un XML
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

Codice Codice Un esempio per Application type
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

Codice Codice 4d e PHP: un esempio concreto
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.

Codice Codice Eseguire una query con i comandi External Data Source
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

Codice Codice Trovare errori nei TAG html [2]
` ======================================
    ` 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


Codice Codice Trovare errori nei TAG html [1]
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.

Codice Codice Messenger, AIM o ICQ fra client 4D con poco codice
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


Codice Codice Liberare la memoria dopo aver usato un XML
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 !!!!
Codice Codice Calcolo del giorno di Pasqua
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

Codice Codice Percorso dell'applicazione o della struttura
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)
Codice Codice Mantenere i colori del method editor
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.

Codice Codice Spostamento circolare sulle ListBox
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

Codice Codice Cancellare record non bloccati
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.

Codice Codice Programma risolutore Sudoku: metodo ricorsivo
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


Codice Codice Programma risolutore Sudoku: metodo iterativo
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


Codice Codice Calcolo Coefficienti Sistema lineare di 3 equazioni
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

Codice Codice Riempire una combo su una pagina web
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).

Codice Codice Spostamento delle immagini in Picture Library
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
Codice Codice Calcolo lunghezza massima dei testi nei campi
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
Codice Codice Aprire le porte seriali con Serial ToolKit for 4D
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.

Codice Codice Esporta descrizione struttura di una Tabella
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

Codice Codice Apertura di un file con 4D 2003
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.
Codice Codice Calcolo della varianza
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


Codice Codice Ottenere l'indirizzo IP
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.
Codice Codice Conversione da numero arabo a numero romano
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
Codice Codice Conversione da numero romano a numero arabo
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


Codice Codice Leggere i tag ID3 di un file MP3
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.
Codice Codice Cambiare logo nei formati
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;*)

Codice Codice Rendere maiuscole tutte le prime lettere
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

Codice Codice La compressione dei Blob
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
Codice Codice Importare numeri negativi da Excel o FileMaker
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)

Codice Codice Calcolo del checksum per il protocollo MODBUS
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.

Codice Codice Come controllare il il numero di licenze dei Plug-in di 4D Server
(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)


Codice Codice Convertire un metodo per eseguirlo su Server
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

Codice Codice Lanciare un'applicazione esterna
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")
Codice Codice Evidenziare un elemento al passaggio del Mouse
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

Codice Codice I Parametri e la funzione Massimo
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)

Codice Codice Metodo di controllo dell'Input da tastiera
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
Codice Codice Backup della cartella MAC4DX ed i file .bundle
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)
Codice Codice Creare un Quick Report da programma
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.
Codice Codice Individuare il tipo di formato della data
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

Codice Codice Cancellazioni multiple nelle list box
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)

Codice Codice Calcolo del checksum di un codice a barre EAN13 *
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


2
Codice Codice Contare il numero di elementi di un file XML
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

Codice Codice Il tasto Control su Mac e Win
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

Codice Codice Convertire un ottale in decimale
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

Codice Codice Ripristinare gli indici
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.

Codice Codice Trovare un elemento in un documento XML usando XPath
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")
Codice Codice Lanciare applicazioni senza mostrare le finestra
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."
Codice Codice Chiedere la data all'utente
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

Codice Codice Identificare il tipo di un'immagine
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)
Codice Codice Aprire le finestre del Pannello di controllo con AP Sublaunch
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

Codice Codice Creare un nuovo metodo da programma con 4D Pack
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.
Codice Codice Uso dei semafori
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

Codice Codice Comunicazione via porta seriale
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)

Codice Codice Anticipare l'inserimento di una parola
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
Codice Codice Importare/esportare campi con immagini
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)
Codice Codice Ripulire i dati dopo una importazione DBF
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.
Codice Codice Estrarre i nomi e i valori da un url
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
Codice Codice Spostamento di una sottolista gerarchica
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)
Codice Codice Lista dei processi attivi
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)
Codice Codice Trasformare un blob in un array di testo
  `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
Codice Codice Velocizzare le liste di output
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.
Codice Codice Modificare l'input da tastiera
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
Codice Codice Chiudere il 4D server interagendo con le dialog
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
Codice Codice Cercare una stringa all'interno di un BLOB
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
Codice Codice Conoscere lo stato della base dati da remoto
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
Codice Codice Trovare il valore di un attributo di un elemento XML usandone il nome
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


Codice Codice Totali nelle liste di Output
Per mostrare una somma alla fine di una selezione in un normale layout mostrato con una Display selection non basta scrivere

:(Form event= On Header)
v_TotRow:=Sum([Fatture]Euro_tot)

ma se la display selection è suscettibile di cambiamenti a causa di
query, use set ecc bisogna scrivere nel metodo della Form

:(Form event= On Header)
v_TotRow:=Sum([Fatture]Euro_tot)
Set Visible(v_TotRow;True)

così il valore si aggiorna ad ogni cambio di record visibili.
Codice Codice Ricerca di elementi negli array bidimensionali
Come ben sappiamo, il comando Find in array ritorna il primo elemento di un array che corrisponde a un certo valore. Per gli array bidimensionali il processo è lievemente differente.
Supponiamo di avere:

Array Text(Myarray;2;2)
Myarray{1}{1}:="Cinema"
Myarray{1}{2}:="Teatro"
Myarray{2}{1}:="Film"
Myarray{2}{2}:="Commedia"

Se cerchiamo la parola Cinema 4D ci restituisce:

$find:=Find in array(Myarray{1};"Cinema")
$find1:=Find in array(Myarray{2};"Cinema")
$find sarà 1
$find1 sarà -1

Per effettuare una ricerca diretta su tutto l'array allora si scriverà:

$arrSize:=Size of array(Myarray)
For ($i;1;$arrSize)
  $find:=Find in array(Myarray{$i};"Cinema")
    If ($find>0)
      `qualsiasi cosa
  End if
End for
Codice Codice Controllo delle strutture bloccate usando le password
4th Dimension permette di usare un database da CD: in questo caso, giustamente, la struttura risulta bloccata. In generale però è bene controllare se la struttura è bloccata o meno: se via 4D Client modifico una struttura bloccata, le modifiche saranno scritte in cache e uscendo da 4D Server andranno perse: il caso tipico è la copia della struttura da CD a disco fisso (in ambiente Windows).

Un modo per controllare se una strutura è bloccata può essere quello di modificare le password della struttura via codice: per eseguire questa operazione la struttura non deve risultare bloccata, altrimenti viene generato un errore -9937. Nel database method "On Startup" verrà lanciato questo processo:

$ref:=New process("MyLockProc";32*1024)

Il metodo lanciato avrà questa forma:

ON ERR CALL("ControlloErrori")
DELAY PROCESS(Current Process;60)
GET USER PROPERTIES(2;name;startup;pass;uses;dat)
$error:=Set user properties(2;name;startup;pass;uses;dat)
ON ERR CALL("")

Nella procedura ControlloErrori posso visualizzare messaggi di errore.

IMPORTANTE: il metodo di controllo deve partire su un nuovo processo e il DELAY PROCESS iniziale deve essere di almeno 60 tick.
Codice Codice Ricerca su tutti i campi testuali di una Tabella
  ` Ricerca di una stringa su tutti i campi alfanumerici e testo di una tabella
    ` _________________________________________________________________
    ` $1 = Puntatore alla tabella
    ` _________________________________________________________________

C_POINTER($1)
C_STRING(80;$Alfa)
C_POINTER($PtrField;$PtrTable)
C_INTEGER($FieldNum;$TableNum;$NumeroMinimoCaratteri)

$PtrTable:=$1
$NumeroMinimoCaratteri:=3

$Alfa:=Request("Cerca...: (min. "+String($NumeroMinimoCaratteri)+" car.)")
If ((ok=1) & ($Alfa#""))
If (Length($Alfa)>=$NumeroMinimoCaratteri)
$TableNum:=Table($PtrTable)
$FieldNum:=Count fields($PtrTable)
For ($i;1;$FieldNum)
$PtrField:=Field($TableNum;$i)
If ((Type($PtrField->)=Is Alpha Field ) | (Type($PtrField->)=Is Text ))
QUERY($PtrTable->;$PtrField->=$Alfa;*)
$i:=$FieldNum+100
End if
End for

  ` Verifica che abbia eseguito la query precedente
If ($i>($FieldNum+10))
For ($i;1;$FieldNum)
$PtrField:=Field($TableNum;$i)
If ((Type($PtrField->)=Is Alpha Field ) | (Type($PtrField->)=Is Text ))
QUERY($PtrTable->; | $PtrField->="@"+$Alfa+"@";*)
End if
End for
QUERY($PtrTable->)
Else
Alert ("Assenza campi alfanumerici in tabella")
End if
Else
Alert ("Devi introdurre almeno "+String($NumeroMinimoCaratteri)+" caratteri")
End if
End if
    ` _________________________________________________________________
Codice Codice Controllare lo stato di un processo senza process ID
Il comando Process state ritorna lo stato di un processo il cui numero viene passato come parametro. In realtà è possibile controllare lo stato di un processo anche quando non se ne conosca il numero, ma solo il nome. Il seguente frammento di codice lo dimostra:

C_LONGINT($0)
C_STRING(255;$1)
$0:=Process state(Process number($1))

Passando come parametro il nome del processo, il comando Process number ne ritorna il numero. Questo numero viene così poi passato a Process state.

Codice Codice Uscita corretta da 4D Server con Stored procedure
Una stored procedure è un processo lanciato sulla macchina server.

L'utilizzo di questa tecnica è molto spesso indicato perché limita la comunicazione via network fra client e server.
Una stored procedure può essere lanciata:

- da 4D Server, usando il comando New process;

- da 4D Client, usando il comando Execute on server.

Vediamo di usarla per eseguire una corretta uscita da 4D Server.
Nel database method "On Server Startup" inseriamo questo codice:

<>StopServer:=False
<>StoredProc:=New process("Server_Method";32*1024;"StoredProc (server)")

Il metodo "Server_Method" non fa altro che un ciclo molto semplice, che dura finché <>StopServer non diventa "Vero"

Repeat
        $currentTime:=Current time
        
        DELAY PROCESS(Current process;60)
Until (<>StopServer=True)


Ora, esistono due modi, come ben sappiamo di uscire da 4D Server:
- "Disconnect from server in nn min." è sicuramente il più pericoloso: trascorso il numero di minuti TUTTI I PROCESSI VERRANNO CHIUSI, con grosso rischio, ovviamente di integrità del database;
- "Wait for all Users to disconnect" attende che tutti i client vengano chiusi.

Se viene usato questo secondo sistema di chiusura del server, è possibile usare la variabile <>StopServer impostata precedentemente per controllare nelle varie stored procedures se il server sta o meno per chiudersi.

Per fare in modo che 4D Server attenda la conclusione dei vari processi si può usare questo codice nel database method "On Server Shutdown" (dobbiamo controllare tutti i processi possibili del server, quindi anche Web):

  <>StopServer:=True
      
`inizializzo

      $Index:=1
      $nbUsersProcs:=5
      $serverReady:=11
      
      Repeat
          
           ` Quanti processi vivi?
           $nbProcess:=Count user processes
          
           ` Condizione dei processi kernel
           $interface:=ProcessExist (204;1) ` process 'User interface'
           $client:=ProcessExist (204;2) ` process 'Client manager'
           $cache:=ProcessExist (204;3) ` process 'Cache manager'
           $web:=ProcessExist (401;1) ` process 'Web server'
           $index:=ProcessExist (204;4) ` process 'Index manager'
          
           ` Una variabile che condensa gli stati
           $serverReady:=$interface+$client+$cache+$web+$index
          
           ` Delay per 5 secondi
           DELAY PROCESS(Current process;300)
          
      Until (<>StopServer=True) & ($index=0) & ($nbProcess<5) & ($serverReady<11)


Il metodo "ProcessExist" controlla lo stato dei processi kernel accedendo alle risorse:

  ` $1 => STR# number
      ` $2 => STR# item number
      ` $0 <= number

      $0:=Process number(Get indexed string($1;$2))


Così, se $index è uguale a zero, significa che nessun processo di indicizzazione è in corso e il server può uscire.

Un altro approccio potrebbe essere quello di far lanciare un processo al client che controlli lo stato di <>StopServer, in modo che possa completare tutti i suoi processi prima che venga eseguito il comando "Quit 4D"
Codice Codice Comporre i numeri telefonici da 4D
Posto di avere un modem collegato alla porta seriale del computer, ecco un metodo che utilizza i comandi seriali di 4D e i comandi AT del modem per comporre un numero di telefono.

$numero_t:=$1
SET CHANNEL(MacOS Serial Port+Protocol XONXOFF;Speed 1200+Data bits 8+Stop bits One+Parity None)
SEND PACKET("+++") `Reinizializza il modem
DELAY PROCESS(Current process;120) `Pausa di 2 secondi
$messaggio:="AT S7=0 M1 DT"+$numero_t +Char(13)
SEND PACKET($messaggio)
DELAY PROCESS(Current process;120) `Pausa di 2 secondi
SET CHANNEL(11) `Chiude la porta seriale
Codice Codice Scaricare con il client il programma 4D su cui siamo connessi
Procedura da lanciare sul server

CREATE RECORD([ARCHIVI])
[ARCHIVI]NomeArchivio:="NOME STRUTTURA DEL PROGRAMMA"

$NuovoArchivio:=[ARCHIVI]NomeArchivio+"2"
vErrore:=0
ok:=1

ON ERR CALL("ErroreSuBlob")
$TipoArchivio:=Document type([ARCHIVI]NomeArchivio)
If (($TipoArchivio#"") & (ok=1))
    COPY DOCUMENT([ARCHIVI]NomeArchivio;$NuovoArchivio;*)
    If (ok=1)
        $Ref:=Open document($NuovoArchivio)
        If (ok=1)
           CLOSE DOCUMENT($Ref)
           [ARCHIVI]TipoArchivio:=Document type(Document)
           If (ok=1)
           DOCUMENT TO BLOB(Document;[ARCHIVI]DataFork)
           If (ok=1)
           COMPRESS BLOB([ARCHIVI]DataFork)
           End if
           If (ok=1)
           DOCUMENT TO BLOB(Document;[ARCHIVI]ResourceFork;*)
           If (ok=1)
           COMPRESS BLOB([ARCHIVI]ResourceFork)
           End if
           End if
           End if
        End if
        
        DELETE DOCUMENT($NuovoArchivio)
    End if
End if
ON ERR CALL("")
[ARCHIVI]DataModifica:=Current date(*)
[ARCHIVI]OraModifica:=Current time(*)
[ARCHIVI]BytesDataFork:=BLOB size([ARCHIVI]DataFork)
[ARCHIVI]BytesResourceFork:=BLOB size([ARCHIVI]ResourceFork)
SAVE RECORD([ARCHIVI])

UNLOAD RECORD([ARCHIVI])

procedura da lanciare sul client (anche in remoto) dopo il tempo necessario al completamento della prima da parte del server

$NuovoArchivio:=[ARCHIVI]NomeArchivio+" copia"
$Ref:=Create document($NuovoArchivio;[ARCHIVI]TipoArchivio)
If (ok=1)
    CLOSE DOCUMENT($Ref)
    EXPAND BLOB([ARCHIVI]DataFork)
    EXPAND BLOB([ARCHIVI]ResourceFork)
    BLOB TO DOCUMENT($NuovoArchivio;[ARCHIVI]DataFork)
    BLOB TO DOCUMENT($NuovoArchivio;[ARCHIVI]ResourceFork;*)
End if

su mac osx la struttura viene memorizzata dentro il pacchetto di 4D
Codice Codice Campi booleani come testo: un altro approccio
Abbiamo visto in una faq sui Quick Report come trasformare un campo booleano in testo.

Un sistema altrettanto interessante di risolvere il problema potrebbe essere utilizzare i formati associabili al comando String. Se volgio infatti Mostrare il testo "Vero" oppure "Falso" a seconda del valore di un campo booleano posso scrivere:

$0:=String(Num($1);"Vero;;Falso")
Codice Codice Usare i tasti freccia per scorrere la lista di record
Sarà capitato a tutti di ricevere da un cliente la richiesta di poter utilizzare le frecce per poter scorrere le liste di record nel form di output di una tabella.

Per chi non usa la 2004 ecco un metodo da associare a quattro pulsanti non visibili nel form di output. Ad ognuno dei pulsanti collegare la pressione dei pulsanti "Freccia Giù" "Freccia Su" "Pag Giù" "Pag Su".

Il metodo, prendendo come parametri la tabella corrente, l'azione e opzionalmente il numero di record da saltare selezionerà il record successivo/precedente o salterà avanti/indietro di "$3" record:

DEFAULT TABLE($1->)
C_LONGINT($N;selectedRecord)
$N:=Records in selection($1->)
$pTable:=$1
BOOLEAN ARRAY FROM SET($set_ab)
$numeroRecord_l:=Find in array($set_ab;True;0)
LONGINT ARRAY FROM SELECTION($pTable->;$record_al)
selectedRecord:=Find in array($record_al;$numeroRecord_l)

If (Count parameters>2)
  $quanti:=$3
Else
  $quanti:=1
End if

Case of
  : ($2="down")
    selectedRecord:=selectedRecord+$quanti
    If (selectedRecord>$N)
      selectedRecord:=$N
    End if

  : ($2="up")
    selectedRecord:=selectedRecord-$quanti
    If (selectedRecord<1)
      selectedRecord:=1
    End if

End case

GOTO SELECTED RECORD($1->;selectedRecord)

CREATE EMPTY SET($1->;"ListSet")
ADD TO SET($1->;"ListSet")
HIGHLIGHT RECORDS("ListSet")
CLEAR SET("ListSet")

Usando lo stesso principio si potrebbero aggiungere anche i pulsanti per selezionare il primo o l'ultimo record della lista.
Codice Codice Impostare i valori di default
Nelle form di input è possibile prevedere che un campo sia già compilato con la data o l'ora corrente, o con il successivo Sequence Number.

Nelle proprietà dell'oggetto Campo, nella riga Default Value è possibile scrivere:

#H per l'ora corrente

#D per la data corrente

#N inserisce il sequence number o numero progressivo automatico
Codice Codice Convertire un numero di secondi in formato Ora
Ecco un modo semplice per convertire un valore LongInt che corrisponda al numero di secondi in un valore Time, Ora:

ora_h:=Time(Time string(46800)) ` come scrivere ora_h:=?13:00:00?

Nota che 86.400 secondi sono 24 ore. Se converti un numero che è più grande di 86.400, la funzione Time string aggiungerà ore, minuti e secondi.

Quindi, Time string (86401) ritornerà 24:00:01.
Codice Codice Il percorso alla cartella Desktop
Ecco un metodo per avere un'informazione utile, ma non così semplice da ottenere.

C_TEXT($0;$percorso_t;$4Dfolder_t)
C_LONGINT($platform;$system;$vlSys;$i)
PLATFORM PROPERTIES($platform;$system)
If ($platform=Windows)
      $percorso_t:=System folder(Desktop Win )
Else
      $vlSys:=$system\256
      If ($vlSys=16)
           $percorso_t:=System folder(Preferences or Profiles_User )
           $percorso_t:=Replace string($percorso_t;"Library:Preferences:";"Desktop:")
      Else
           $4Dfolder_t:=System folder(System )
           For ($i;1;Length($4Dfolder_t))
              If ($4Dfolder_t[[$i]]=":")
                 $percorso_t:=Substring($4Dfolder_t;1;$i)+"Desktop Folder:"
                 $i:=Length($4Dfolder_t)+1
              End if
           End for
      End if
End if
$0:=$percorso_t
Codice Codice Usare un solo metodo per tutte le voci di menu
Piuttosto che creare un metodo per ogni voce di menu, si può pensare di scrivere un unico metodo "Menu_Manager" che gestisca tutte le possibili chiamate da menu. Questa tecnica risulta interessante perché permette di gestire le chiamate anche dinamicamente.

` Project Method: Menu_Manager

C_TEXT($SelectedMenuItem)
$SelectedMenuItem:=Get menu item(Menu selected\65536;Menu selected%65536)

Case of
: ($SelectedMenuItem="Nuovo Record")
` Chiama qui il Metodo per creare un record
: ($SelectedMenuItem="Record successivo")
` Chiama qui il Metodo per andare al record successivo
: ($SelectedMenuItem="Record precedente")
` Chiama qui il Metodo per andare al record precedente
: ($SelectedMenuItem="Stampa report")
` Chiama qui il Metodo per stampare un report
End case

Codice Codice Evitare la duplicazione dei processi
Se abbiamo l'accortezza (o usiamo il sistema) di dare ad ogni processo un nome che lo identifichi univocamente, siamo già pronti a controllare che uno stesso processo sia lanciato più volte (e dunque duplicato).
Basta usare infatti il parametro "*" del comando New process: se esiste già un processo con lo stesso nome di quello che stiamo creando, New process restituirà l'id del processo esistente, invece di crearne uno nuovo. Ecco dunque un'idea di metodo di apertura dei processi, che prende come parametri nome del metodo, dimensione dello stack e nome del processo:

C_TEXT($1;$3;$NomeDelMetodo_t;$NomeDelProcesso_t)
C_LONGINT($2;$StackSize_l;$procid_l)
$NomeDelMetodo_t:=$1
$StackSize_l:=$2
$NomeDelProcesso_t:=$3
$procid:=New process($NomeDelMetodo_t;$StackSize_l;$NomeDelProcesso_t;*)
BRING TO FRONT($procid_l)
Codice Codice Mostrare il Quick Report e il suo Wizard da progranmma
Il Quick Report e il suo Wizard sono disponibili da ambiente User, ma se volessimo permetterne l'uso anchedall'ambiente Custom in un proprio programma è possibile utilizzare il comando QR Report.
Il comando accetta fino a sei parametri - QR Report( {tabella;} documento {;hierarchical {;wizard {;search}}} {;*})- dove solo il primo è obbligatorio. Per visualizzare l'editor del Quick Report, basta passare il nome di un documento che non esiste (se esiste il QR Report lo apre e la calcola direttamente); impostando a True il parametro Wizard è possibile rendere disponibile all'utente anche questa funzionalità.

Di seguito riportiamo il codice per dare la possibilità all''utente di realizzare, stampare e salvare i propri report:

QUERY([Tabella])
If (OK=1)
  QR REPORT([Tabella];Char(1);False;True;False)
End if

Come puoi vedere, il parametro del documento è passato come il carattere Char(1), un nome di documento che non esiste, e il parametro wizard è passato come true.
Codice Codice Quale Runtime usare per distribuire un applicativo
Innanzitutto elenchiamo la corrispondenza dei nomi della versione 2004 in confronto con i precedenti:

4D Runtime Interpreted = 4D Runtime
4D Runtime Single User = 4D Runtime Classic
4D Runtime Volume License Light = 4D Engine Light Edition
4D Runtime Volume License Sponsored = 4DEngine Sponsored Edition Illimited
4D Runtime Volume License Pro = 4D Engine Pro Edition

Ecco riassunte le differenze:
4D Runtime Interpreted: gratuito, distribuzione illimitata, unico limite applicazioni non compilate, è separato dalla struttura (quindi non è una sola applicazione doppio cliccabile).
4D Runtime Single User: 106 Euro per un utente, per le applicazioni compilate, separato dalla struttura.
4D Runtime Volume License Light: gratuito con 4d o Server Developer, distribuzione illimitata, compilato come singola applicazione, unico limite la creazione di massimo 50 record per tabella (solo se si aggiungono, quindi posso usare una tabella piena con più di 50 record).
4D Runtime Volume License Sponsored : 1.069 Euro, distribuzione illimitata, compilato come singola applicazione, alla chiusura del programma appare per qualche secondo una finestra con scritto www.4d.com.
4D Runtime Volume License Pro : 2.674 Euro, fino a 1000 utenti, compilato come singola applicazione, senza finestra sponsor alla fine.

Tutti funzionano in sola lettura, ad esempio su CD.

Il modo più economico di sviluppare con 4d è comprare la versione di 4D Standard Edition da 299 Euro e distribuire il proprio applicativo con il 4D Runtime Interpreted, che è gratuito e senza altre limitazioni se non quello della compilazione.

Nota: I prezzi sono Iva esclusa e del listino della versione 2004; ad oggi (nov/04) è possibile comprare anche la versione 6.8 e 2003. Inoltre ogni tanto Italsoftware fa accordi con alcune riviste (Mac e/o Windows) per la distribuzione di una standard edition inclusa nel cd allegato, praticamente gratuita.
E' possibile, a meno delle nuove caratteristiche e di eventuali differenze estetiche, programmare con una versione precedente e distribuire il software con una versione più nuova del Runtime.
Codice Codice Controllare se Quicktime è installato su Windows
Mentre QuickTime è di default installato su Mac, la stessa cosa non si può dire su Windows. Per controllare se QuickTime è installato o meno è necessario utilizzare dei piccoli trucchi da codice. Ad esempio:

PICTURE TYPE LIST($array1;$array2)

Se la dimensione di uno di questi array è almeno uno, allora QuickTime è installato.
Un altro sistema potrebbe essere questo:

GET PICTURE RESOURCE(9000;$vPicture) `carica un'immagine
If (OK=1)
      PICTURE TO BLOB($vPicture;$myBlob;"JPEG")
End if

Il comando cerca di convertire l'immagine in JPEG. Se la dimensione del BLOB è zero, allora la conversione non è stata eseguita e quindi QuickTime non è installato.
Codice Codice 4D e PHP
Per poter servire pagine dinamiche con Php generalmente si utilizza questa configurazione: web server + php +  backend verso un database Mysql o altro.
Php si integra facilmente con molti database SQL attraverso i vari moduli ODBC, ma non si integra direttamente con 4D Web Server (su Mac non c'è il driver ODBC per 4d) e non esiste un "4D open for php", quindi una soluzione può essere quella di usare i WebServices.

In una realtà in cui esiste già un server Apache + Php è stato sviluppato un database 4D.  
I dati di 4D accessibili via client vengono quindi anche mostrati in alcune pagine dinamiche offerte da Apache, non utilizzando 4D come Web Server, ma pubblicando alcune procedure come Web Services (SOAP).  

Ecco i passi indispensabili eseguiti in 4D:
1 - Il Server 4D installato ha le licenze web (nella versione 2004 è possibile acquistare solo il modulo per i webservices che costa meno) e il Web Server è attivo (Ambiente User: Menu Web Server : Start Web Server).
2 - Sempre lato server, impostare le Preferenze per i Web Services. In questo caso 4D fa da Server per le SOAP quindi verificare solamente le opzioni per Server Side. Sicuramente impostare "Allow Web Services Requests". Gli altri due parametri sono stati lasciati come di default.
3 - Creazione di un metodo usufruibile via Web Services: Menu Designer:New Method: wbSerTest. Per questo metodo dal menu Method:Method Properties: selezionare due opzioni da Attributes : Offered as a web Service, e Published in WSDL. Questo permette di richiamare il metodo come una funzione che dall'esterno accetta parametri e restituisce valori.
      
  ` metodo wbSerTest  offerto via SOAP  
C_INTEGER(in_RowQty; RowQty)
C_TEXT(AskDescr;in_AskDescr)
C_BLOB(Articles_Bl;Blob_tmp)
SET BLOB SIZE(Articles_Bl;0)
RowQty:=0
SOAP DECLARATION(AskDescr;Is Text ;SOAP Input ;"in_AskDescr")
SOAP DECLARATION(RowQty;Is Integer ;SOAP Input ;"in_RowQty")
SOAP DECLARATION(Articles_Bl;Is BLOB ;SOAP Output )
If (Length(AskDescr)>5)
    READ ONLY(*)
    If (RowQty<=0)
      RowQty:=10
    End if  
    QUERY([Articles];[Articles]Description= AskDescr)
    If (Records in selection([Articles])>0)
      ORDER BY([Articles];[Articles]Description;>)
      REDUCE SELECTION([Articles];RowQty)
      $tmp:=""
      While (Not(End selection([Articles])))
        $tmp:=[Articles]Description+Char(9)+[Articles]Code+Char(13)
        TEXT TO BLOB($tmp;Articles_Bl;3;*)
        NEXT RECORD([Articles])
      End while  
    Else  
      TEXT TO BLOB("empty query";Articles_Bl;3;*)
    End if  
End if  

  Lato Php:

require_once('nusoap.php');
//nusoap.php scaricabile a quest'indirizzo:

//http://dietrich.ganx4.com/nusoap/

//mi connetto al server sul quale "gira" 4d
// e' importante notare 4DSOAP come parte del percorso
$soapclient = new soapclient('http:///4DSOAP/');  
//Qui definisco i parametri da passare alla funzione
$parameters = array('in_AskDescr'=>valore1,'in_RowQty'=>valore2);
$ret =  $soapclient->call('wbserTest',$parameters);
if(!$ret)
  {
    print "Error:" . $soapclient->getError() . '\n<br><br>';
    exit;
  }
    else
    echo "Risultato : " . var_dump($ret) . '\n<br>';
  }
//Attenzione: se la funzione restituisce un parametro come risultato allora $ret sara' una
//variabile semplice altrimenti sara' un array associativo che avra' come chiavi i nomi delle
//variabili che restituisce la funzione .
//"Spengo il client"
unset($soapclient);
?>


Funziona.

Si ringrazia per il contributo Mauro Donadello
Codice Codice Salvare il documento di un plugin
Usare SAVE RECORD per salvare un record che contiene un campo blob con una plugin area (tipo WriteArea_) non salva automaticamente il contenuto del campo come farebbe ACCEPT.

Questo perché per SAVE RECORD non vale il salvataggio automatico del blob-plugin nel campo che invece ACCEPT esegue. Per eseguire correttamente il salvataggio è quindi necessario fare manualmente la conversione a blob dell'area del plugin. Usando come plugin, ad esempio, 4D Write, la sequenza da seguire è:

[Tabella]WriteArea_:=WR AREA TO BLOB(WriteArea;1)
SAVE RECORD([Tabella])

Codice Codice Controllo cartelle vuote
Ecco un piccolo metodo per controllare se una cartella è vuota. Il metodo riceve come parametro il percorso completo alla cartella e restituisce True se la cartella è vuota.

C_BOOLEAN($0)
C_TEXT($1;$percorso_t)
ARRAY TEXT($arrelementi_t;0)
$percorso_t:=$1
$0:=False
FOLDER LIST($percorso_t;$arrelementi_t)
If (Size of array($arrelementi_t)=0)
    DOCUMENT LIST($percorso_t;$arrelementi_t)
        If (Size of array($arrelementi_t)=0)
           $0:=True
        End if
End if

Codice Codice Ottenere il nome di un mese dalla data
Questi due frammenti di codice permettono di conoscere il nome del mese di una data passata come parametro. Viene usata la risorsa 'STR#' con ID=11.
Il primo frammento restituisce il nome del mese in formato abbreviato:

` $1 - Data
` $0 - Nome breve del mese
$0:=Get indexed string(11;Month of ($1))

Il secondo il nome per esteso:

` $1 - Data
` $0 - Nome del mese
$0:=Get indexed string(11;12+Month of ($1))

Codice Codice Ottenere un numero da una data e viceversa
Ecco un semplice metodo che converte una data in un ben determinato numero:

  ` Project Method: DaDataANumero
C_LONGINT($0)
C_DATE($1;$data)
$data:=$1
$0:=$data-!00/00/00!

Avendo un numero si può quindi ottenere la data relativa con questo metodo inverso:

    ` Project Method: DaNumeroAData
C_LONGINT($1)
C_DATE($0;$data)
$data:=!01/01/01!+$1
$0:=$data-(!01/01/01!-!00/00/00!)

Codice Codice QPix: ottenere informazioni su un'immagine
Il comando PICTURE PROPERTIES permette di ottenere, direttamente da linguaggio quindi, informazioni sulla dimensione in pixel di un'immagine, ma non la sua risoluzione in dpi e/o la profondità di colore. Per ottenere queste informazioni è possibile usare le funzioni di QPix QPx_GetImageFileInfo e QPx_GetPictureInfo (per un'introduzione a QPix è possibile consultare questa faq).

I parametri che usano sono simili e la sintassi è praticamente identica. Entriamo nel dettaglio.
La sintassi è:

QPx_GetImageFileInfo(imagePath; imageWidth; imageHeight; pixelDepth; hRes; vRes)

e

QPx_GetPictureInfo(pictVar; pictWidth; pictHeight; pixelDepth; hRes; vRes)

dove:
- imagePath è il percorso al file di cui vogliamo ottenere le informazioni;
- pictVar è invece la variabile 4D che contiene la pict di cui vogliamo ottenere informazioni;
- pictWidth e pictHeight vengono riempiti dai comandi con i valori relativi la larghezza e altezza dell'immagine;
- pixelDepth viene riempito con un valore che rappresenta la profondità di colore dell'immagine (1 per il bianco e nero, 2 8 16 24 e 32 per le immagini a colori, 34 [2 bit], 36 [4-bit], 40 [8 bit] per le immagini a scala di grigi);
- hRes e vRes vengono riempiti con la risoluzione orizzontale e verticale dell'immagine espressa in dots per inch (dpi).

Vediamo un esempio di uso di QPx_GetImageFileInfo

  `Ottenere info su un'immagine da file
C_LONGINT($error)
C_TEXT($imagePath)
C_LONGINT($width;$height;$depth;$hRes;$vRes)
  
$imagePath:="Hard disk:Barocco in Sicilia:Contea di Modica:Montalbano:San Pietro.gif"
  
$error:=QPx_GetImageFileInfo ($imagePath;$width;$height;$depth;$hRes;$vRes)
  
If ($error=qpx_noErr)
      `usa i dati ottenuti
End if


Un esempio per QPx_GetPictureInfo:

  `Info su una pict
  
C_LONGINT($error)
C_PICTURE($picture)
C_LONGINT($width;$height;$depth;$hRes;$vRes)
  
$picture:=[Chiese di Modica]Immagine
  
$error:=QPx_GetPictureInfo ($picture;$width;$height;$depth;$hRes;$vRes)
  
If ($error=qpx_noErr)
      `usa i dati ottenuti
End if
Codice Codice Controllare i privilegi di accesso della struttura
Installando una struttura sul server potrebbe capitare (n funzione del tipo di collegamento usato) che i privilegi di accesso si impostino in modo tale che l'utente corrispondente al 4D Server non abbia accesso in scrittura (cioé sia in Sola Lettura).

Poiché il tutto sembra funzionare e le modifiche alla struttura (di programmazione o anche di modifica delle liste o delle passord, per esempio) resterebbero online fino alla chiusura del programma; a quel punto 4d Server tenta di registrarle ma non riesce.

Ecco una procedura da installare nel metodo "On Startup Server" che esegue un controllo ed eventualmente avvisa l'utente della cosa prima di chiudersi (i nomi delle variabili non sono significative, per cui sono stati lasciati brevi):

  Error_l:=0
  ON ERR CALL("CatturaErrori")
  GET DOCUMENT PROPERTIES(Structure file;lck_b;inv_b;cr_d;cr_h;md_d;md_h)
  SET DOCUMENT PROPERTIES(Structure file;lck_b;inv_b;cr_d;cr_h;md_d;md_h)
  ON ERR CALL("")
  If (Error_l =-5000)
        ALERT("Attenzione, controlla i privilegi di accesso alla struttura.")
        QUIT 4D
  End if

Ci vuole anche il methodo “CatturaErrori”

Error_l:=Error `Error contiene l'errore intercettato, e lo copia nella variabile usata dopo

Suggerito da Thomas Schlumberger, 4d Francia
Codice Codice Uso di SET COLOR in un output form
Capita spesso che sia necessario già in fase di visualizzazione della lista dei record consentire una analisi di un certo dato della tabella. Ad esempio il programma potrebbe far vedere con colori diversi nella lista le ragioni sociali dei clienti che non acquistano da più di 60 giorni.

Nell'object method del campo Ragione scriveremo:
If ((Current date-UltimoAcquisto)>60)
    SET COLOR(Ragione;-256*Red )
Else
    SET COLOR(Ragione;-Black )
End if

Però le righe vuote alla fine della lista avranno il colore dell'ultimo record visualizzato e non quello standard (qui il nero). Per sistemare questo intanto inseriamo nel metodo del form il seguente codice:

If (Form event=On Header )
    SET COLOR(Ragione;-Black )
End if


Codice Codice Riconoscere un anno bisestile *
Ecco un piccolo frammento di codice che prende in input un numero e restituisce True se l'anno rappresentato dal numero è bisestile:

C_BOOLEAN($0)
C_LONGINT($1;$anno_l)
$anno_l:=$1
$0:=True
Case of
    : (Dec($anno_l/400)=0)
        `è bisestile, come il 2000
    : (Dec($anno_l/100)=0)
        `non è bisestile, come il 1900
        $0:=False
    : (Dec($anno_l/4)=0)
        `è un anno bisestile
    Else
        $0:=False
End case


1
Codice Codice Calcolo del numero della settimana *
Seguendo le regole dell'Iso 8601:
- il primo giorno della settimana è Lunedì
- una settimana è contata nell’anno in cui stanno la maggior parte dei giorni
- E’ possibile avere anche anni con 53 settimane

Propongo una soluzione, da testare:

$d:=Date("04-01-"+String(Year of(Current date)))
$0:=Int((Current date-(1+$d-Day number($d)+(7*Num(Day number($d)>4))))/7)+1

Si sarebbe potuto scrivere su più righe per essere più chiari, o in una riga sola per essere più concisi...

1
Codice Codice Programma una ricerca sugli array!
Ecco uno spunto su come effettuare una ricerca su un array: nell'array di partenza vengono cancellati gli elementi che non servono, e così se la dimensione dell'array diventa zero, la ricerca ha risultato nullo.

Al metodo vengono passati come parametri due puntatori, uno all'array (si suppone non vuoto, altrimenti bisogna aggiungere questo controllo) e uno all'elemento cercato.

C_POINTER($1;$2;$puntatoreArray_ptr;$puntatoreValore_ptr)
$puntatoreArray_ptr:=$1
$puntatoreValore_ptr:=$2

C_LONGINT($posizione;$PrimoDaControllare_l;$dimensioneArray_l)
$posizione:=1
$PrimoDaControllare_l:=0
Repeat
  $PrimoDaControllare_l:=$PrimoDaControllare_l+1
  $posizione:=Find in array($puntatoreArray_ptr->;$puntatoreValore_ptr->;$PrimoDaControllare_l)
  If ($posizione>0)
    DELETE ELEMENT($puntatoreArray_ptr->;$PrimoDaControllare_l;$posizione-$PrimoDaControllare_l)
  End if
Until ($posizione<0)

$dimensioneArray_l:=Size of array($puntatoreArray_ptr->)
If ($dimensioneArray_l>=$PrimoDaControllare_l)
  DELETE ELEMENT($puntatoreArray_ptr->;$PrimoDaControllare_l;($dimensioneArray_l-$PrimoDaControllare_l)+1)
End if
Codice Codice Creazione di un codice di controllo CRC
Il codice di controllo CRC, Cyclic Redundancy Check, serve a controllare l'integrità di un insieme di dati, sia esso un file, un pacchetto di bit sulla rete, il testo di una email.

La procedura proposta è ricavata dalla Nota Tecnica di 4d 99-11, dove viene spiegato il processo di calcolo del CRC: in pratica si dividono con operazioni binarie tutti i byte dell'insieme di dati per un polinomio di partenza e si conserva il resto come codice di controllo (o checksum).

In pratica è quasi impossibile che una modifica ai dati diano come risultato lo stesso codice CRC. Il polinomio di partenza consigliato è quello usato nelle trasmissioni Ethernet e nel programma di compressione PkZip.

C_BLOB($1;$blob)  `contiene l'insieme di dati da controllare
C_LONGINT($0;$CRC_L;$REG_L;$TOP_L;$i;$j)
C_BOOLEAN(<>crc_setupFatto_b)  `serve a controllare che il setup sia fatto almeno e solo una volta

If (Not(<>crc_setupFatto_b))
  `prepara una volta soltanto l'array con le operazioni di shift e XOR
  `con il polinomio usato come radice del CRC
  ARRAY LONGINT(<>crcTable_al;255)
  C_REAL($CRCSetup_r;$CRC32_r)
  $CRC32_r:=0x04C11DB7  `polinomio usato come base di calcolo
  For ($i;0;255)
    $CRCSetup_r:=$i
    For ($j;0;7)  `bit shift a destra e XOR con il polinomio
      If (($CRCSetup_r & 1)=1)
        $CRCSetup_r:=(($CRCSetup_r >> 1) ^| $CRC32_r)
      Else
        $CRCSetup_r:=$CRCSetup_r >> 1
      End if
    End for
    <>crcTable_al{$i}:=Abs($CRCSetup_r)
  End for
  <>crc_setupFatto_b:=True
End if

$CRC_L:=0xFFFFFFFF
SET BLOB SIZE(vblob;BLOB size(vblob)+4;0x0000)
$REG_L:=BLOB to longint(vblob;0)
For ($i;0;BLOB size(vblob)-5)
  $TOP_L:=(($REG_L >> 24) & 0x00FF)
  $CRC_L:=<>crcTable_al{$TOP_L}
  $REG_L:=(($REG_L << 8) | vblob{$i+4}) ^| $CRC_L
End for
$0:=Abs($REG_L)
Codice Codice Conversione da decimale a esadecimale
Il sistema più veloce per convertire in esadecimale un numero è il seguente:

$esadecimale_t:=String($decimale_l;"&x") `es. 26 -> 0x1A

oppure

$esadecimale_t:=String($decimale_l;"&$") `es. 26 -> $1A

Codice Codice Chiudere i processi correttamente uscendo da 4D *
Il metodo On Exit Database viene eseguito all'uscita del database. Questo metodo viene eseguito da 4D quando viene eseguita un'istruzione QUIT 4D o quando viene scelta la voce di chiusura applicazione da menu. Se il metodo On Exit Database è vuoto, l'applicazione verrà chiusa immediatamente (senza tenere conto quindi delle operazioni attualmente in esecuzione), altrimenti, se contiene del codice, 4D attende per chiudersi che il metodo venga portato a termine: possiamo sfruttare questa attesa per far sì che i processi attivi vengano chiusi con cognizione.

Intanto, all'apertura del database impostare la variabile booleana <>StoChiudendo_b impostandola a False. A questo punto nell'On Exit Database la impostiamo a True e "risvegliamo" ogni processo:


<>StoChiudendo_b:=True
For ($i;1;Count tasks)
    RESUME PROCESS($i)
    CALL PROCESS($i)
End for


Così facendo il programma sa che 4D sta per chiudersi: ragion per cui si dovrebbe programmare ogni metodo che usa dei cicli e che vogliamo sia chiuso correttamente in maniera tale da controllare lo stato di "chiusura" di 4D guardando il valore della variabile <>StoChiudendo_b.

Per quel che riguarda invece i metodi dei form, visto come abbiamo scritto il metodo di chiusura, viene generato un evento On Outside Call che possiamo gestire:

Case of
    : (Form event=On Outside Call)
      If (<>StoChiudendo_b)
           CANCEL ` o qualsiasi altra istruzione sia necessaria
      End if
End case



1
Codice Codice Aumentare la casualità del comando Random
Il comando Random restituisce un un numero a caso tra 0 e 32.767.
Può capitare che il numero casuale che cerchiamo sia oltre questo limite.
Inoltre il tipico uso che viene fatto del comando è quello di restituire un numero compreso in un certo intervallo.
Ecco quindi un semplice metodo per aumentare le potenzialità del comando Random:

C_LONGINT($minimo_l;$massimo_l;$1;$2)
$minimo_l:=$1
$massimo_l:=$2

C_LONGINT($aCaso_l;$0)
If ($minimo_l=$massimo_l)
    $aCaso_l:=(Random*Random)
Else
    $aCaso_l:=((Random*Random)%($massimo_l-$minimo_l+1))+$minimo_l
End if

$0:=$aCaso_l

1
Codice Codice Decriptate i dati protetti
Ecco come decriptare i dati protetti usando la chiave Public_Key.txt generata insieme alla relativa chiave privata:

C_TEXT($1;$Decriptato_t)
C_BLOB($Criptato_blb;$Pubblica_blb)

TEXT TO BLOB($1;$Criptato_blb;3)
DOCUMENT TO BLOB("Public_Key.txt";$Pubblica_blb)
DECRYPT BLOB($Criptato_blb;$Pubblica_blb)
$Decriptato_t :=BLOB to Text($Criptato_blb;Text without length)
$0:=$Decriptato_t

La variabile $Decriptato_t contiene così il testo decriptato.
Codice Codice Criptare il contenuto di un blob
Ecco un esempio su come criptare il contenuto di un blob, usando una chiave Private_Key.txt già generata:

C_TEXT($1;$DaCriptare_t)
C_BLOB($Criptato_blb;$Privata_blb)

$DaCriptare_t:=$1
TEXT TO BLOB($DaCriptare_t;$Criptato_blb;Text without length)
DOCUMENT TO BLOB("Private_Key.txt";$Privata_blb)
ENCRYPT BLOB($Criptato_blb;$Privata_blb)
BLOB TO DOCUMENT("Criptato.txt";$Criptato_blb)

Così facendo il testo passato come parametro sarà memorizzato criptato nel file Criptato.txt.
Codice Codice Creazione delle chiavi di protezione dati SSL
Per utilizzare la funzione di protezione dei dati di 4D è necessario creare le chiavi RSA (pubblica e privata) che servano a criptare e decriptare i dati utilizzando l'agoritmo usato nel protocollo SSL. La modalità di uso è di tenere la chiave privata al sicuro e distribuire la chiave pubblica: quello che è criptato con una chiave può essere decriptato solo con l'altra.

Ecco un veloce esempio:

C_BLOB($Pubblica_blb;$b_Privata_blb)
GENERATE ENCRYPTION KEYPAIR($b_Privata_blb;$Pubblica_blb)
BLOB TO DOCUMENT("Public_Key.txt";$Pubblica_blb)
BLOB TO DOCUMENT("Private_Key.txt";$b_Privata_blb)
Codice Codice È un numero?
Ecco una piccola porzione di codice per controllare se una stringa, passata come parametro, è o no un numero (inclusi il meno, i punti e le virgole). Il controllo viene fatto sul valore Ascii dei caratteri.

C_TEXT($1;$uncarattere_s)
C_LONGINT($i)
C_BOOLEAN($contienelettere_b)

$contienelettere_b:=False
For ($i;1;Length($1))
    If ($contienelettere_b)
        $i:=Length($1)
    Else
        $uncarattere_s:=Substring($1;$i;1)
        If ((Ascii($uncarattere_s)<44) | (Ascii($uncarattere_s)>57))
          $contienelettere_b:=True
        End if
    End if
End for
$0:=Not($contienelettere_b)
Codice Codice Scrivere testo alla fine di un campo
In un form di input, portando il cursore su un campo testo, la barra di inserimento lampeggia all'inizio del testo (almeno 4D si comporta così). Per fare in modo che invece il cursore lampeggi alla fine del testo è possibile attivare nell'oggetto testo l'evento On Getting Focus e scrivere al suo interno il seguente codice:

Case of
    :(Form event=On Getting Focus)
        HIGHLIGHT TEXT ([Table1]CampoTesto_t;MAXTEXTLEN ;MAXTEXTLEN )
End case

dove MAXTEXTLEN è la costante predefinita di 4D che contiene la massima lunghezza di un testo (32000).
Codice Codice Da una lista di elementi in array
Questo metodo serve a riempire un array di tipo testo con gli elementi di una lista, il cui separatore può essere definito e non limitato ad un carattere. Un suo uso potrebbe essere (vedi gli esempi nel commento): nella lettura di file di testo con i campi separati dal tabulatore, nella individuazione di parole da una frase, delle cartelle in un percorso ad un file, etc

    `Metodo: listaInArray
    `Nexus srl - www.nexusonline.it
    `Descrizione: mette gli elementi di una lista di testo in array
    `$0 = ritorna il numero di elementi letti
    `Nota:l'array deve essere già dichiarato e passato per parametro
    `esempi: $campi:=listaInArray(varLetta;->array_at)
    `esempi: $parole:=listaInArray("uno due tre";->array_at;" ")
    `esempi: $cartele:=listaInArray("MacHD:Lavori:Personali";->array_at;":")
C_TEXT($1;$3;$lista_t;$separatore_t)
C_POINTER($2;$array_ptr)
C_LONGINT($pos_l;$quanti_l)

$lista_t:=$1  `contiene la lista di parole o termini da leggere
$array_ptr:=$2  `contiene un puntatore ad un array text che conterrà il risultato
If (Count parameters=3)
  $separatore_t:=$3  `è opzionale indicare il separatore usato
Else
  $separatore_t:=Char(9)  `altrimenti separatore di default è il Tabulatore
End if
ARRAY TEXT($array_ptr->;0)  `ridimensiona l'array a zero

$pos_l:=Position($separatore_t;$lista_t)  `trova il primo separatore
While ($pos_l#0)  `se c'è almeno un separatore
  $quanti_l:=Size of array($array_ptr->)+1
  INSERT ELEMENT($array_ptr->;$quanti_l)  `1 elemento è il default
  $array_ptr->{$quanti_l}:=Substring($lista_t;1;$pos_l-1)  `estrae il prossimo elemento
  $lista_t:=Substring($lista_t;$pos_l+Length($separatore_t))  `e poi lo cancella dalla lista
  $pos_l:=Position($separatore_t;$lista_t)  `e controlla il prossimo separatore
End while
    `ne rimane ancora uno, anche se solo vuoto
$quanti_l:=Size of array($array_ptr->)+1
INSERT ELEMENT($array_ptr->;$quanti_l)
$array_ptr->{$quanti_l}:=$lista_t
$0:=$quanti_l
Codice Codice Creare un percorso completo ad un file
Supponi di voler creare un documento da 4D e metterlo in un qualche posto sul disco. Dovresti sapere esattamente dove registrare il documento e se quel posto o cartella esiste. Oppure puoi creare il percorso con tutte le cartelle che servono per arrivare alla posizione desiderata dove mettere il documento.

L'esempio che segue, chiamato PreparaPercorso, fa esattamente questo:

C_TEXT($1;$percorso_t;$percorsoCreato_t;$cartella_t)
C_STRING(1;$separatore_t)
C_LONGINT($SistemaOperativo_l)

$percorso_t:=$1

SistemaOperativo_l PROPERTIES($SistemaOperativo_l)

If ($percorso_t#"")

    ` per windows, bisogna passare anche la lettera del disco
    If ($SistemaOperativo_l=Windows)
        If (Position(":\\";$percorso_t)#0)
           $percorsoCreato_t:=Substring($percorso_t;0;Position("\\";$percorso_t))
           $percorso_t:=Substring($percorso_t;Position("\\";$percorso_t)+1)
        End if
        $separatore_t:="\\"
    Else
        $separatore_t:=":"
    End if

    ` aggiungiamo il separatore in coda, se non ci fosse già
    If ($percorso_t[[Length($percorso_t)]]#$separatore_t)
        $percorso_t:=$percorso_t+$separatore_t
    End if

    Repeat

    ` identifica la prossima cartella
        $cartella_t:=Substring($percorso_t;0;Position($separatore_t;$percorso_t))
        $percorso_t:=Substring($percorso_t;Position($separatore_t;$percorso_t)+1)

        $percorsoCreato_t:=$percorsoCreato_t+$cartella_t

    ` la crea se non esiste
        Case of
           :(Test path name($percorsoCreato_t)<0)
             CREATE FOLDER($percorsoCreato_t)
           :(Test path name($percorsoCreato_t)=1)
             $cartella_t:=""
        End case

    Until ($cartella_t="")

End if

Ad esempio, chiamando questo metodo passando questo parametro:

PreparaPercorso("C:\\Prima Cartella\\Seconda\\Ultima cartella\\")

Questo crea queste tre cartelle nel disco C:. Con questo metodo non è necessario preoccuparsi che una posizione esista già, perché se serve il metodo la crea, altrimenti non fa niente.
Codice Codice Importare in Excel i dati da 4D
Per importare in Microsoft Excel dei dati generati da 4D è possibile usare questa procedura (testata su Macintosh, ma non dovrebbe essere dissimile in Windows) in 4D viene attivato il web server e creato un metodo richiamabile con il 4DACTION, del tipo:
      `web_IncassiGiorno
QUERY([Incassi];[Incassi]Data=current date)
$$Risposta_t:=""
While (Not(End selection([Incassi])))
      $Risposta_t:=$Risposta_t+String([Incassi]Scontrino)+Char(9)
      $Risposta_t:=$Risposta_t+String([Incassi]Importo)+Char(13)
      NEXT RECORD([Incassi])
End while
SEND HTML TEXT($Risposta_t)

In un file di testo chiamato "Query4D.txt" si scrive:

WEB
1
http://127.0.0.1/4DACTION/web_IncassiGiorno

Selection=EntirePage
Formatting=All
PreFormattedTextToColumns=True
ConsecutiveDelimitersAsOne=True
SingleBlockTextImport=False


In Microsoft Excel, scegliere dal menu
Data: Get external Data: Run saved query
e scegliere il file "Query4D.txt" appena creato.. et voila!
Codice Codice Estrarre il nome del file dal percorso completo
Questa funzione restituisce il nome di un file estratto da un percorso completo. Ad esempio, per sapere quale base dati è aperta al momento si può usare nel seguente modo, usando la relativa funzione di 4d:
$nomeDati:=getNomeFile(Data file)

    ` getNomeFile
    ` Nexus srl
C_TEXT($0;$1)
C_STRING(255;$nomecompleto_t)
C_INTEGER($car_l)
$nomecompleto_t:=$1
      ` identifico il separatore usato, ":" oppure "\"
$separatore_t:=System folder[[Length(System folder)]]
$car_l:=Length($nomecompleto_t)
While (($car_l>0) & ($nomecompleto_t[[$car_l]]#$separatore_t))
      $car_l:=$car_l-1
End while
If ($car_l>0)
      $0:=Substring($nomecompleto_t;$car_l+1)
Else
      $0:=$nomecompleto_t
End if
Codice Codice Estrarre il percorso della cartella
Questa funzione può essere usata per ottenere il pathname (percorso) della cartella in cui risiede un determinato file di cui si ha il nome completo. Ad esempio, per sapere la cartella dove si trova l'applicazione 4D in funzione al momento, si può usare con la relativa funzione di 4d:
$directory_t:=getPathname(Application File)


      ` getPathname
      ` Nexus srl
C_STRING(255;$1;$0;$nomecompleto_t)
C_STRING(1;$separatore_t)
C_INTEGER($viLen;$viPos;$viChar)

$nomecompleto_t:=$1
$len_l:=Length($nomecompleto_t)
    ` identifico il separatore usato, ":" oppure "\"
$separatore_t:=System folder[[Length(System folder)]]
$car_l:=Length($nomecompleto_t)
While (($car_l>0) & ($nomecompleto_t[[$car_l]]#$separatore_t))
      $car_l:=$car_l-1
End while
If ($car_l>0)
      $0:=Substring($nomecompleto_t;1;$car_l)  `restituisce il percorso
Else
      $0:=$nomecompleto_t  `se non contiene separatori
End if
Codice Codice Convertire da Base64 in Testo Ascii
Da un messaggio inviato da Pete Bozek al 4D Nug internazionale, decodifica in Ascii i dati di un blob in base Base64.

      ` Decode_Base64_Blob
      ` di Peter Bozek
      ` http://www.inforce.sk

C_POINTER($1;$pPassedBlob)
C_LONGINT($i;$iOffset;$iDest)
C_LONGINT($lValue;$lValue1;$lValue2;$lValue3;$lValue4)
C_LONGINT($temp;$temp2)
C_LONGINT($lBlobSize;$lEOLLength)
C_BLOB($oDecoding)
C_STRING(64;$encoding)

$pPassedBlob:=$1
$lBlobSize:=BLOB size($pPassedBlob->)

If ($lBlobSize>0)
      $encoding:="ABCDEFGHIJKLMNOPQRSTUVWXYZ"
      $encoding:=$encoding+"abcdefghijklmnopqrstuvwxyz0123456789+/"

      SET BLOB SIZE($oDecoding;0x00FF;0x0040)
      For ($i;1;64)
          $oDecoding{Ascii($encoding[[$i]])}:=$i-1
      End for
      SET BLOB SIZE($pPassedBlob->;(($lBlobSize+3)\4)*4;0x0000)
      $lBlobSize:=BLOB size($pPassedBlob->)
          `ridimensionare il blob non dovrebbe essere necessario!
      $iOffset:=0
      $iDest:=0
      While ($iOffset<$lBlobSize)
          If ($oDecoding{$pPassedBlob->{$iOffset}}=0x0040)  `non fa parte di uno stream
            $iOffset:=$iOffset+1
          Else
              `prende blocchi di 4 Byte
            If ($iOffset<($lBlobSize-1))
              $lValue:=BLOB to longint($pPassedBlob->;Macintosh byte ordering ;$iOffset)    
              $lValue1:=$lValue >> 0x0018
              $lValue2:=($lValue >> 0x0010) & 0x00FF
              $lValue3:=($lValue >> 0x0008) & 0x00FF
              $lValue4:=$lValue & 0x00FF
              $pPassedBlob->{$iDest}:=($oDecoding{$lValue1} << 2) | ($oDecoding{$lValue2} >> 4)
              $iDest:=$iDest+1
              $temp:=$oDecoding{$lValue3}
              If ($temp<0x0040)
                $pPassedBlob->{$iDest}:=($oDecoding{$lValue2} << 4) | ($temp >> 2)
                $iDest:=$iDest+1        
                $temp2:=$oDecoding{$lValue4}
                If ($temp2<0x0040)
                  $pPassedBlob->{$iDest}:=($temp << 6) | $temp2
                  $iDest:=$iDest+1
                End if
              End if
            Else
              $iOffset:=$lBlobSize
            End if
          End if
      End while

      If ($iDest>0)
          SET BLOB SIZE($pPassedBlob->;$iDest)
      End if
End if
Codice Codice Convertire da Testo Ascii in Base64
Da un messaggio inviato da Pete Bozek al 4D Nug internazionale, fa la codifica in Base64 di un testo passato come blob. Gli altri due parametri opzionali indicano se inserire un salto riga e che tipo di carattere usato (il default è il Return).

      ` Encode_Base64_Blob
      ` di Peter Bozek
      ` http://www.inforce.sk

C_POINTER($1;$pPassedBlob)
C_BOOLEAN($2;$bInsertLineBr)
C_STRING(2;$3;$sEOL)
C_LONGINT($iPos;$iDest;$iWritten;$iWhere)
C_LONGINT($lBlobSize;$lNewSize;$lEOLLength)
C_BLOB($oTempBlob)
C_STRING(64;$encoding)

$pPassedBlob:=$1
$lBlobSize:=BLOB size($pPassedBlob->)
If ($lBlobSize>0)
        `carica i parametri
      If (Count parameters>1)
          $bInsertLineBr:=$2
      Else
          $bInsertLineBr:=True
      End if
      $lEOLLength:=0
      If ($bInsertLineBr)
          If (Count parameters>2)
            $sEOL:=$3
          End if
          If ($sEOL="")
            $sEOL:=Char(Carriage return )
          End if
          $lEOLLength:=Length($sEOL)
      End if

          `prepara i data
      COPY BLOB($pPassedBlob->;$oTempBlob;0;0;$lBlobSize)
      SET BLOB SIZE($oTempBlob;(($lBlobSize+2)\3)*3;0x0000)
      SET BLOB SIZE($pPassedBlob->;0)
      $lNewSize:=(($lBlobSize+2)\3)*4
      If ($bInsertLineBr)
          $lNewSize:=$lNewSize+(($lNewSize+75)\76)*$lEOLLength
      End if
      SET BLOB SIZE($pPassedBlob->;$lNewSize;0x0000)
      $encoding:="ABCDEFGHIJKLMNOPQRSTUVWXYZ"
      $encoding:=$encoding+"abcdefghijklmnopqrstuvwxyz0123456789+/"
      $iPos:=0
      $iDest:=0
      If ($bInsertLineBr)  `start with NL
          TEXT TO BLOB($sEOL;$pPassedBlob->;Text without length ;$iDest)
            `$iDest:=$iDest+$lEOLLength
      End if
      While ($iPos<$lBlobSize)
          $iWhere:=($oTempBlob{$iPos} >> 2)
          $pPassedBlob->{$iDest}:=Ascii($encoding[[$iWhere+1]])
          $iDest:=$iDest+1
          $iWhere:=(($oTempBlob{$iPos} << 4) & 0x0030) | ($oTempBlob{$iPos+1} >> 4)
          $pPassedBlob->{$iDest}:=Ascii($encoding[[$iWhere+1]])
          $iDest:=$iDest+1
          $iWhere:=(($oTempBlob{$iPos+1} << 2) & 0x003C) | (($oTempBlob{$iPos+2} >> 6) 0x0003)
          $pPassedBlob->{$iDest}:=Ascii($encoding[[$iWhere+1]])
          $iDest:=$iDest+1
          $iWhere:=$oTempBlob{$iPos+2} & 0x003F
          $pPassedBlob->{$iDest}:=Ascii($encoding[[$iWhere+1]])
          $iDest:=$iDest+1
          $iPos:=$iPos+3
          $iWritten:=$iWritten+4
          Case of
            : ($iPos=($lBlobSize+1))
              $pPassedBlob->{$iDest-1}:=Ascii("=")
            : ($iPos=($lBlobSize+2))
              $pPassedBlob->{$iDest-1}:=Ascii("=")
              $pPassedBlob->{$iDest-2}:=Ascii("=")
          End case
          If ($bInsertLineBr & ($iWritten%76=0))
            TEXT TO BLOB($sEOL;$pPassedBlob->;Text without length ;$iDest)
              `$iDest:=$iDest+$lEOLLength
          End if
      End while
End if
Codice Codice Costruire una Lista Gerarchica
Ecco un codice di esempio per costruire una lista gerarchica di due livelli, basata su una struttura con una tabella [Padri] e una di [Figli] in relazione.

C_LONGINT(Lista_l;$sottolista_l;$padri_l)
ListaGerarchica_l:=New list  ` Ne creo una nuova
ALL RECORDS([Padri])
For ($padri_l;1;Records in selection([Padri]))
      RELATE MANY([Padri])  `seleziona eventuali figli di questo padre
      If (Records in selection([Figli])>0)  `controlla se ce ne sono
           ORDER BY([Figli];[Figli]Nome)
           $sottolista_l:=New list  `crea una lista temporanea dei figli
           For ($i;1;Records in selection([Figli]))
               `per ogni figlio aggiunge il figlio all'elenco dei figli
              APPEND TO LIST($sottolista_l;[Figli]Nome;-1*Record number([Figli])) 
              NEXT RECORD([Figli])
           End for
      End if
        ` aggiunge il padre e il suo elenco dei figli alla lista principale
      APPEND TO LIST(ListaGerarchica_l;[Padri]Nome;Record number([Padri]);$sottolista_l;True)
      NEXT RECORD([Padri])
End for
Codice Codice Metodo antispam
Durante la cena seguita alla conferenza del 17 giugno, mi è stato chiesto di pubblicare il metodo con cui abbiamo creato alcune mail nell'html del sito.
Scrivo due righe di documentazione: il metodo prende come parametro un indirizzo di posta e ne crea uno in un formato ascii comprensibile dal browser internet. Da questa conversione viene "esentato" il secondo carattere dell'indirizzo per evitare che uno snake faccia in automatico la conversione da ascii a carattere in maniera troppo semplice e automatica.

C_TEXT($IndirizzoOriginale_t;$IndirizzoModificato_t; mailto_t)
C_LONGINT($i;$k)

$IndirizzoOriginale_t:=$1
$mailto_t:="mailto:"  `"mailto:" in formato ascii
$IndirizzoModificato_t:=""
For ($i;1;Length($IndirizzoOriginale_t))
    If ($i=2)
        $IndirizzoModificato_t:=$IndirizzoModificato_t+$IndirizzoOriginale_t[[$i]]
    Else
        $IndirizzoModificato_t:=$IndirizzoModificato_t+"&#"+String(Ascii($IndirizzoOriginale_t[[$i]]))+";"
    End if
End for

$IndirizzoModificato_t:=$mailto_t+$IndirizzoModificato_t
$0:=$IndirizzoModificato_t
Codice Codice Stringhe identiche in 4th Dimension
Il controllo di uguaglianza di 4D non tiene conto dei caratteri accentati nè della differenza fra maiuscole e minuscole. Ecco un piccolo frammento di codice per controllare se due stringhe sono uguali. Il confronto viene fatto sui valori Ascii dei caratteri.


C_STRING(80;$1;$2;$Stringa1_s;$Stringa2_s)
C_LONGINT($i)
$Stringa1_s:=$1
$Stringa2_s:=$2
$0:=True
If (Length($Stringa1_s)#Length($Stringa2_s))
      $0:=False
  Else
      For ($i;1;Length($Stringa1_s))
          If (Ascii($Stringa1_s[[$i]])#Ascii($Stringa2_s[[$i]]))
           $0:=False
           $i:=Length($tString1)+5
          End if
      End for
End if
Codice Codice Ottenere le date di 4DTools con un metodo
4DTools aggiorna automaticamente una risorsa all'interno della struttura ogni volta che viene eseguita una operazione di controllo o una riparazione. Il seguente metodo restituisce queste informazioni:

` I parametri:
` $1 - Tipo di informazione da ottenere, i valori accettati sono:

` 1 = Data dell'ultimo controllo del file dati;
` 2 = Data dell'ultima riparazione del file dati;
` 3 = Data dell'ultimo controllo della struttura;
` 4 = Data dell'ultima riparazione della struttura.
` $0 - La data richiesta

      
C_LONGINT($1;$dateType_l) `la variabile locale per $1
C_DATE($ultimadata_d;$0) `la variabile locale per $0

C_BLOB($resData_x) `conterrà la risorsa
C_LONGINT($anno_l;$mese_l;$giorno_l) `giorno mese e anno della data
C_LONGINT($resID_l) `conterrà l'ID della risorsa
C_TIME($resourceDoc_ref) `conterrà il reference number della risorsa aperta.

$dateType_l:=$1


Case of
    : ($dateType_l=1) `ultimo controllo del file dati
        $resID_l:=3
        $resourceDoc_ref:=Open resource file(Data file)

    : ($dateType_l=2) `ultima riparazione del file dati
        $resID_l:=4
        $resourceDoc_ref:=Open resource file(Data file)

    : ($dateType_l=3) `ultimo controllo della struttura
        $resID_l:=1
        $resourceDoc_ref:=Open resource file(Structure file)

    : ($dateType_l=4) `ultima riparazione della struttura
        $resID_l:=2
        $resourceDoc_ref:=Open resource file(Structure file)
Else
        ` Errore
End case

GET RESOURCE("RegA";$resID_l;$resData_x;$resourceDoc_ref)

If (BLOB size($resData_x)>0)
    $anno_l:=($resData_x{0}*256)+$resData_x{1}
    $mese_l:=($resData_x{2}*256)+$resData_x{3}
    $giorno_l:=($resData_x{4}*256)+$resData_x{5}

    $ultimadata_d:=Add to date(!00/00/00!;$anno_l;$mese_l;$giorno_l)-1

End if

$0:=$ultimadata_d `restituisce la deta cercata



Fonte: Phillip Hall, 4DToday
Codice Codice Come confrontare due blob
Ecco un metodo semplice per sapere se due blob sono uguali; ovviamente il primo controllo che fa è che siano della stessa lunghezza e poi controlla carattere per carattere. Da notare che in questo modo i caratteri sono contrallati esattamente, cioè un carattere maiuscolo è diverso dallo stesso minuscolo (case sensitive).

`Metodo: confrontaBlob
`Parametri:
` $1 = Blob; $2 = Blob
`Risultato:
` $0: Vero se uguali, altrimenti falso

C_BLOB($1;$2)
C_BOOLEAN($0)
If (BLOB size($1)=BLOB size($2))
  $0:=True
  For ($vByte;0;BLOB size($1)-1)
    If ($1{$vByte}#$2{$vByte})
      $0:=False
      $vByte:=BLOB size($1)
    End if
  End for
Else
    $0:=False
End if
Codice Codice Codici a barre, conversioni tra Code 39 a Code 32 Farmacod
Non pochi lettori di codici a barre in commercio non gestiscono il Code 32 Farmacod perche' e' usato solo in Italia. In questi casi il Code 32 viene interpretato come Code 39 rendendo inutilizzabile la lettura. Il Code 32 in Italia e' largamente usato non solo per tutti i farmaci ma anche per molti prodotti cosmetici e d'igiene di uso corrente.

Questi due brevi method operano le conversioni:

    ` Conversion from CODE 39
    ` to Italian Farmaceutical Code
    ` for bar code reader
    ` whithout automatic conversion
    ` R.V. 29/07/2000

C_TEXT($1;$0)
C_REAL($result)
C_INTEGER($len;$base10;$base32)
$result:=0
$len:=Length($1)
For ($X;1;$len)
    $char:=($1<=($len-$X+1)>=)
    $base32:=Ascii($char)
    $base10:=$base32-(48+(8*Num($base32>65))+*Num($base32>69)+*Num($base32>73)+*Num($base32>79))
    $result:=$result+($base10*(32^($X-1)))
End for
$0:=String($result)
$0:=("0"*Num(Length($0)=8))+$0



    ` Conversion from CODE 39
    ` to CODE 32 Farmacod
    ` (Italian farmaceutical code)
    ` R.V. 29/07/2002

C_TEXT($1;$0)
C_REAL($value)
C_INTEGER($X;$codASCII)
C_LONGINT($base32)
$value:=Num($1)
$0:=""
For ($X;1;6)
    $base32:=$value-(Int($value/32)*32)
    $codASCII:=$base32+48+((8*Num($base32>9))+Num($base32>12)+Num($base32>15)+Num($base32>20))
    $0:=Char($codASCII)+$0
    $value:=Int($value/32)
End for
Codice Codice Conversione da binario a decimale e viceversa
Ecco due metodi per convertire un numero da binario a decimale e viceversa. Il numero da convertire è il parametro passato. Il numero binario è sempre trattato come stringa.

` DaBinarioADecimale
$lunghezza_l:=Length($1)
$0:=0
For ($i;0;($lunghezza_l-1))
    If ($1[[$lunghezza_l-$i]]="1")
        $0:=$0 ?+ $i
    End if
End for

`DaDecimaleABinario
$0:=""
For ($i;0;31)
    If ($1 ?? $i)
        $0:="1"+$0
    Else
        $0:="0"+$0
    End if
End for
Codice Codice Controllo del Codice IBAN
L’IBAN (International Bank Account Number) è la coordinata bancaria internazionale che consente di identificare, in maniera standard, il conto corrente del beneficiario permettendo all’ordinante o alla banca di quest’ultimo di verificarne la correttezza grazie ai due caratteri di controllo.

  La struttura dell’IBAN per l’Italia è fissata in 27 caratteri:
  1) IT = ISO Country Code, identificativo per l'italia (SM per San Marino)
  2) 1 = CIN carattere alfabetico di controllo
  3) 5 = ABI o Bank Code solo numeri
  4) 5 = CAB o Branch Code solo numeri
  5) 12 = C/C numero di conto (solo numeri riempito a sinistra di zeri)

Potete trovare nfo più dettagliate sul sito: http://www.ecbs.org/iban.htm

    `Marco Caratto 5-3-2004
    `procedura di verifica codice IBAN, restituisce True se corretto
C_TEXT($1;$V_Tx_Deposito;$V_Tx_StringaRisultante)
C_INTEGER($V_I_conta;$V_I_Carattere;$V_I_Resto)  ` variabile contatore
C_BOOLEAN($0)
$0:=True  ` imposto il default a vero
$V_Tx_StringaRisultante:=""  ` variabile per la stringa di controllo
$V_I_Resto:=0  ` variabile per il resto della divisione per 97
If (Length($1)<5) 
  ` se la lunghezza del iban è inferiore a 5 è sbagliato
  $0:=False
Else
  ` metto i primi 4 caratteri in coda
  $V_Tx_Deposito:=Substring($1;5)+Substring($1;1;4)  
  If (Substring($1;3;2)>"96")
    $0:=False  ` il codice di controllo non può essere superiore a 96
  Else
    For ($V_I_conta;1;Length($V_Tx_Deposito))
    ` esamino il$V_I_conta esimo carattere
      $V_I_Carattere:=Ascii(Substring($V_Tx_Deposito;$V_I_conta;1))  
      If (($V_I_Carattere>=48) & ($V_I_Carattere<=57))  ` per cifra 0-9
        If (($V_I_conta=(Length($V_Tx_Deposito)-3)) | ($V_I_conta=(Length($V_Tx_Deposito)-2)))
          $0:=False  ` il primo ed il secondo carattere non possono essere numeri
        End if
        $V_I_Numero:=$V_I_Carattere-48
      Else
        If (($V_I_Carattere>=65) & ($V_I_Carattere<=90))  ` per cifra 0-9
          If (($V_I_conta=(Length($V_Tx_Deposito)-1)) | ($V_I_conta=(Length($V_Tx_Deposito))))
           $0:=False  ` il terzo ed il quarto carattere non possono essere lettere
          End if
          $V_I_Numero:=$V_I_Carattere-55
        End if
      End if
      If ($V_I_Numero>9)
        $V_I_Resto:=Mod((100*$V_I_Resto+$V_I_Numero);97)
      Else
        $V_I_Resto:=Mod((10*$V_I_Resto+$V_I_Numero);97)
      End if
    End for
  $0:=($V_I_Resto=1)  ` se il resto finale è 1 il codice è corretto
  End if
End if
Codice Codice Passaggio da Subtable a Tabella in relazione
Le Subtable sembrano comode, ma per loro natura hanno molti limiti. In genere succede che dopo qualche tmepo si ha la necessità di usare invece una tabella in relazione.

Ecco come fare il passaggio (in linea generale):
- creare una tabella secondaria con gli stessi campi della subtable più un campo chiave che identifichi il record padre;
- tirare una relazione dalla tabella secondaria alla primaria e impostare gli automatismi Molti a Uno e Uno a Molti: in questo modo quando si seleziona il record padre si ha quasi sempre selezionati i sotto-record nella tabella secondaria (in alcuni casi aggiungere comunque nel codice un Relate Many)
- cercare con l'insider tutte le occorrenze dei campi nella sottotabella e sostituirli con i campi della tabella secondaria;
- cercare tutti i query subrecords, order subrecords by, etc e sostituirli con comandi che abbiano la stessa funzione (ad esempio: all subrecords dovrebbe diventare relate many, create subrecords diventa create record ed in più impostare il campo chiave, etc)
- passare i dati dalla subtable alla nuova tabella, usando un codice come il seguente:
  
ALL RECORDS([TabellaPadre])
For ($i;1;Records in selection([TabellaPadre]))
  LOAD RECORD([TabellaPadre])
  ALL SUBRECORDS([TabellaPadre]CampoSubT)
  For ($j;1;Records in subselection([TabellaPadre]CampoSubT)
    CREATE RECORD([TabellaSecondaria])
    `impostiamo il campo chiave che distingue il padre
    [TabellaSecondaria]Campo_1:=[TabellaPadre]Campo_Chiave
    `questi invece sono gli stessi campi
    [TabellaSecondaria]Campo_2:=[TabellaPadre]CampoSubT'Campo_1
    [TabellaSecondaria]Campo_3:=[TabellaPadre]CampoSubT'Campo_2
    SAVE RECORD([TabellaSecondaria])
    NEXT SUBRECORD([TabellaPadre]CampoSubT)
  End for
  UNLOAD RECORD([TabellaPadre])
  NEXT RECORD([TabellaPadre])
End for
Codice Codice Alternativa a USE SET
Quando nelle liste l'utente seleziona un record su cui eseguire l'azione di un pulsante, in genere si usa l'istruzione USE SET("Userset") che ha l'effetto collaterale di perdere la selezione corrente inclusa del suo ordinamento.

E' possibile invece usare questo breve metodo che va a puntare al record selezionato dall'utente e ne fa il record corrente, senza modificare la selezione.
  
  `Nexus srl 17-7-2003
  `http://www.nexusonline.it
ARRAY BOOLEAN($set_ab;0)
ARRAY LONGINT($record_al;0)
C_LONGINT($numeroRecord_l)
C_POINTER($pTable)

If (Nil(Current default table))
  $pTable:=Current form table
Else
  $pTable:=Current default table
End if

BOOLEAN ARRAY FROM SET($set_ab)  `UserSet è il Default
$numeroRecord_l:=Find in array($set_ab;True;0)  `nota lo start = 0
LONGINT ARRAY FROM SELECTION($pTable->;$record_al)
GOTO SELECTED RECORD(Find in array($record_al;$numeroRecord_l))
Codice Codice Forzare l'esecuzione dell'evento On Validate
La pressione di un pulsante in un form di input che esegue un Accept non comporta automaticamente che venga generato un evento On Validate. Questo accade solo nel caso in cui 4D si accorga che un campo è stato modificato.
Una maniera molto semplice ma al contempo elegante che consenta al programmatore di eseguire questa "forzatura" consiste nel creare un metodo con questo codice:

C_POINTER($1;$field;$table)
$table:=$1
$field:=Field(Table($table);1) `punta al primo campo della tabella :-)))
$field->:=$field-> `si assegna a se stesso, tipo particella di sodio

Questo forza l'esecuzione dell'evento On Validate.
Codice Codice Evitare il copia-incolla delle proprie password
Sebbene sia possibile nascondere il contenuto di una variabile usando il font "password" di 4D, il contenuto della variabile può comunque essere copiato negli appunti e quindi poi facilmente visualizzato!
Il secondo esempio riportato sul manuale del linguaggio di programmazione di 4D per il comando FILTER KEYSTROKE aggira il problema attraverso l'uso di due variabili: una (quella contenuta nel form) contiene dei caratteri casuali, l'altra invece, non visibile, contiene la password reale. Eccone lo stralcio:

` userPassword_t è l'oggetto del form e questo è il metodo di questo oggetto
Case of
    : (Form event=On Load )
        userPassword_t:=""
        PasswordAttuale_t:=""
    : (Form event=On Before Keystroke )
           `il metodo Handle keystroke è da copiare dalla faq corrispondente
        Handle keystroke (-> userPassword_t;-> PasswordAttuale_t)
        If (Position(Keystroke;Char(Backspace )+Char(Left Arrow Key )+Char(Right Arrow Key )+Char(Up Arrow Key )+Char(Down Arrow Key ))=0)
           FILTER KEYSTROKE(Char(65+(Random%26)))
        End if
End case
Codice Codice Limitare l'inserimento di caratteri in una variabile
Inserendo del testo in un campo di tipo Alpha, all'utente viene automaticamente impedito di inserire un numero di caratteri maggiore del numero di caratteri che il campo stesso può contenere. È possibile sviluppare un metodo che simuli questa caratteristica anche nelle variabili intercettando gli eventi On Before Keystroke e On After Keystroke.
Il metodo risultante, prendendo come parametri il puntatore alla variabile e il numero di caratteri consentiti, potrebbe avere questa forma:

Case of
        :(Form event=On Before Keystroke)
          VecchiaVariabile_t:=Get edited text `il testo prima dell'inserimento

        :(Form event=On After Keystroke)
          If (Keystroke#Char(Backspace Key)) `escludo la cancellazione

           $attuale_t:=Get edited text
           If (Length($attuale_t)>$2)
           $1->:=VecchiaVariabile_t
           BEEP
           End if

          End if

End case
Codice Codice Visualizzare il dettaglio in una finestra diversa dalla lista
In automatico le applicazioni 4th Dimension visualizzano il layout di input nella stessa finestra in cui era visualizzato quello di output. Per fare in modo che invece venga aperta una nuova finestra è necessario abilitare l'evento On Double Clicked nel form di output e scrivere nel metodo del form alcune righe tipo queste:

Case of
          :(Form event=On Double Clicked)
           FILTER EVENT
           IlMioMostraRecord(Current form table)
End case

Quando l'utente esegue un doppio clic su un record, 4D lo intercetta; a questo punto l'istruzione FILTER EVENT dice a 4D di non gestire in automatico l'evento e invece eseguire il mio metodo personalizzato di visualizzazione.

Il metodo potrebbe avere una forma di questo tipo:

C_POINTER($1;$table_ptr)
$table_ptr:=$1

$recordNumber_l:=Record number($table_ptr->)
UNLOAD RECORD($table_ptr->)

$processName_t:="Input"
$processNumber_l:=New process("MostraRecord2";64*1024;$processName_t;$table_ptr;$recordNumber_l;Current process;*)
If ($processNumber_l>0)
          BRING TO FRONT($processNumber_l)
End if
Codice Codice Metodo di Invio Mail da 4D
C_LONGINT($Smtp_l;Errore_l)
C_STRING(30;$SmtpUser_s;30;$SmtpPassword_s)
C_TEXT($SmtpServer_t;$Mittente_t;$Destinatario_t;$Titolo_t;$Testo_t)

$SmtpServer_t:="mail.sviluppo4d.it"
$Mittente_t:="sito@sviluppo4d.it"
$Destinatario_t:="umigliore@nexusonline.it"
$Titolo_t:="Messaggio di Prova"
$Testo_t:="Ti sto inviando un messaggio di prova"

` queste due variabili servono se il server richiede l'autenticazione
` è possibile altrimenti lasciarle vuote
$SmtpUser_s:="sito"
$SmtpPassword_s:="miapassword"

` questi due comandi automatizzano la conversione dei caratteri accentati
` serve lanciarli una volta sola allo startup del programma
SMTP_SetPrefs(1;1;0)
$Errore_l:=SMTP_Charset(1;1)

$Errore_l:=SMTP_New($Smtp_l)
$Errore_l:=SMTP_Host($Smtp_l;$SmtpServer_t)
$Errore_l:=SMTP_From($Smtp_l;$Mittente_t)
$Errore_l:=SMTP_To($Smtp_l;$Destinatario_t)
$Errore_l:=SMTP_Subject($Smtp_l;$Titolo_t)
$Errore_l:=SMTP_Comments($Smtp_l;"Inviato con 4th Dimension")
$Errore_l:=SMTP_Body($Smtp_l;$Testo_t)
$Errore_l:=SMTP_Auth($Smtp_l;$SmtpUser_s;$SmtpPassword_s)
$Errore_l:=SMTP_Send($Smtp_l)
$Errore_l:=SMTP_Clear($Smtp_l)

Codice Codice Rapido Trasferimento Dati
Quando dovete convertire una base dati da una versione precedente, o volete fare un backup rapido, ecco due metodi veloci da usare e sempre utili:

`Metodo DB_ESPORTA
`Nexus srl 30-3-2004
C_LONGINT($quantetabelle_l;quantirecords_l;$i;$j)
C_POINTER($pointer_p)
$quantetabelle_l:=Count tables
For ($i;1;$quantetabelle_l)
      SET CHANNEL(10;Table name($i)+"_"+String($i))
      $pointer_p:=Table($i)
      DEFAULT TABLE($pointer_p->)
      ALL RECORDS
      $quantirecords_l:=Records in selection
      FIRST RECORD
      MESSAGE("Esporta "+Table name($i))
      For ($j;1;$quantirecords_l)
           GOTO XY(2;2)
           MESSAGE(String($j)+"/"+String($quantirecords_l))
           SEND RECORD
           NEXT RECORD
      End for
      SET CHANNEL(11)
End for

`Metodo DB_IMPORTA
`Nexus srl 30-3-2004
C_LONGINT($quantetabelle_l;$i;$j)
C_POINTER($pointer_p)
$quantetabelle_l:=Count tables
For ($i;1;$quantetabelle_l)
      SET CHANNEL(10;Table name($i)+"_"+String($i))
      $pointer_p:=Table($i)
      DEFAULT TABLE($pointer_p->)
      $j:=0
      MESSAGE("Importo "+Table name($i))
      While (ok=1)
           $j:=$j+1
           RECEIVE RECORD
           If (ok=1)
           GOTO XY(2;2)
           MESSAGE("Record "+String($j))
           SAVE RECORD
           End if
      End while
      SET CHANNEL(11)
End for

Accesso

User:
Pass: Accedi

Cerca

Se non trovi le informazioni che cerchi scrivi a aiuto@sviluppo4d.it

4D Principali

4D Discussioni

Faq random


Crediti

Dominio registrato da ZetaNet
Sito realizzato da Nexus srl
4D SQL 11.9.0 offerto da 4D & Italsoftware
Icone di FAMFAMFAM
Moderato da Umberto Migliore
301 utenti registrati

Pagina servita il 19/03/24 alle 08:23:08 Valid HTML 4.01! Valid CSS!

Mutuo Facile, iDigitalScout, iDigitalTags e altre app di Nexid srl per iPhone e iPad

Cidroid, distributore italiano lettori barcode per IOS Apple iPhone, iPod, iPad