Collapsed Container in VFP

http://expertsoftwarecompany.wordpress.com/2012/12/22/collapsed-containter-in-vfp/

Un site gratuit pentru promovare site-urilor

O pagina, http://trafic-site.ro, care face schimb de trafic pentru promovarea mai rapida a site-urilor personale.

Programul de contabilitate ICAS, este pregatit pentru aplicarea sistemului "Tva la Incasare"

http://expertsoft.eu/news.php?extend.71.2

Reversing Forum Romania - Comunitatea dezvoltatorilor de aplicatii din Romania

Reversing Forum Romania
Comunitatea dezvoltatorilor de aplicatii din Romania.
http://reversing.ro

Inaltime minima a unui rand dintr-un grid

Pentru a acoperi toate situatiile posibile (daca se foloseste temele din windows, inaltimea minima creste cu 1 pixel fata de cea din documentatie, daca se schimba Zoom-ul (100%, 125%, 150%)  in Se7en)

nMinimRowHeight =  SysMetric(15) + 3.

De cat timp este pornit calculatorul

Declare Integer StrFromTimeInterval In Shlwapi;
String @ pszOut, Integer cchMax, Integer dwTimeMS, Integer digits

Declare Integer GetTickCount In kernel32
nIni = GetTickCount()

cSalida = Space(50)

=StrFromTimeInterval (@cSalida, Len(cSalida), nIni, 10)
Wait Window cSalida

Converirea dimensiune fisier in valoarea corespunzatoare

Function _ApiFileSize(tnBytes As Number)
Text To Exemple NoShow TextMerge
   = _ApiFileSize(532)
   = _ApiFileSize(1340)
   = _ApiFileSize(23506)
   = _ApiFileSize(2400016)
   = _ApiFileSize(2400000000)
   = _ApiFileSize(4294967295)
EndText
Declare STRING StrFormatByteSize IN Shlwapi INTEGER dw, STRING @ pszBuf, INTEGER cchBuf
    pszBuf = SPACE(50)
    Return Transform(tnBytes) +  " -> " +  StrFormatByteSize (m.tnBytes, @pszBuf, Len(pszBuf))
EndFunc

Numarul de randuri visibile intr-un grid

With This.Grid1
   nCeldas = Int(.Height - .HeaderHeight)/.RowHeight
   Wait Windows Transform(nCeldas)EndWith

Afisare imagini variate intr-o lista

Public oform1
oform1=NewObject("form1")
oform1.Show
Return
Define Class form1 As Form
Top = 65
Left = 192
DoCreate = .T.
Caption = "Imagenes en ListBox"
Name = "Form1"
Add Object list1 As ListBox With ;
Height = 181, ;
Left = 36, ;
Top = 24, ;
Width = 300, ;
Name = "List1"

Procedure list1.Init
Set Path To Home(4) + "ICONS\MISC"
With This
.AddItem("Usuario 1",1,1)
.Picture(1) = "FACE01.ICO"
.AddItem("Usuario 2",2,1)
.Picture(2) = "FACE02.ICO"

.AddItem("Usuario 3",3,1)
.Picture(3) = "FACE02.ICO"

.AddItem("Usuario 2",4,1)
.Picture(4) = "FACE03.ICO"
EndWith

EndProc
EndDefine

Copiere rapida a unui tabel in Excel

Function FastExcelCopy (tcTable As String, tcXlsFile As String, tlOpen) As VOID HelpString 'Copieaza o tabela in Excel'
If Not Used(TcTable)
MessageBox("Eroare: Tabela nu este deschisa !", 16, "Eroare")
Return
EndIf
Local lnWorkArea
lnWorkArea = Select()

Select (tcTable)
Local lcTmpFile
lcTmpFile = GetEnv("TEMP")+"" + Sys(2015) + ".Tmp"
Copy To (lcTmpFile) Delimited With Tab
_Cliptext = FileToStr(lcTmpFile)

oExcel= Createobject("Excel.Application")
With oExcel
.DisplayAlerts = .F.
.Workbooks.Add()
    .Range("A1").PasteSpecial
EndWith
If PCount()>1
oExcel.Workbooks(1).SaveAs(tcXlsFile)
EndIf
If Not tlOpen
oExcel.Quit
oExcel= .Null.
Release oExcel
EndIf
Select (lnWorkArea)
EndFunc

Excel Graph

#Define Tab Chr(9)
#Define CRLF Chr(13)+Chr(10)

Public oGraph
_Cliptext = "" ;
+ Tab + "Depto X" + Tab + "Depto Y" + CRLF + ;
"Arroz" + Tab + "248" + Tab + "297" + CRLF+;
"Maíz" + Tab + "339" + Tab + "440" + CRLF+;
"Cereal" + Tab + "500" + Tab + "489" + CRLF+;
"Papas" + Tab + "125" + Tab + "235" + CRLF+;
"Otros" + Tab + "631" + Tab + "455" + CRLF

oGraph = GetObject("","Excel.Chart")

With oGraph.Application
.Visible= .T.
.WorkSheets(1).Cells().Clear
.WorkSheets(1).Cells(1,1).PasteSpecial
.Charts[1].AutoFormat(-4100,1)
EndWith

Eliminare spatii suplimentare dintr-un sir

Function RemoveExtraSpace(tcSir)
lnCountR = Ceiling( SQrt( Occurs(Space(1), tcSir) ) )
Return Evaluate ;
(;
Replicate([StrTran(], lnCountR) + [tcSir] + Replicate([, Space(2), Space(1))], lnCountR) ;
)
EndFunc

Arhivare cu WinZip

oZip = CreateObject("WScript.Shell")
oZip.Run("Winzip -a -r -p -ex c:\archiva.zip c:\Director_de_Arhivat\*.*", 0,.T.)

Release oZip
oZip = Null

Convertire ADO in Cursor cu ajutorul XML-ului

cCadCon = "Provider=VFPOLEDB;Data Source=" +_Samples +"data estdata.dbc"

oCon = Createobject("AdoDb.Connection")oCon.ConnectionString = cCadCon
oCon.Open

oRS = oCon.Execute("Select * From Customer")

xDOM = Newobject("MSXML.DOMDocument")

oRS.Save(xDOM, 1)
oRS.CloseoCon.Close

XmlToCursor(xDOM.XML, "MyCursor", 1028)Select MyCursorBrowse

inregistrare licenta MSMAPI.MAPISession

REGEDIT4


[HKEY_CLASSES_ROOTLicensesDB4C0D00-400B-101B-A3C9-08002B2F49FB]
@="mgkgtgnnmnmninigthkgogggvmkhinjggnvm"

Dezactivare firewall

Run netsh firewall Set opmode Disable

Arata Desktopul Windowsului din VFP

oShellApp = CreateObject("Shell.Application")
oShellApp.ToggleDesktop

Activare dezactivare tasta PrintScreen

#Define VK_PRINTSCREEN 0x2c
Declare Integer RegisterHotKey In user32 ;
Integer HWnd ;
, Integer Id ;
, Integer fsModifiers ;
, Integer vk
* Dezactivare
RegisterHotKey(_Screen.HWnd, 0, 0, VK_PRINTSCREEN)
* Activare
Declare Integer UnregisterHotKey In user32 Integer HWnd, Integer Id
UnregisterHotKey(_Screen.HWnd, 0)

Aflarea spatiului ocupat de o tabela DBF

*Select lcAlias
Wait Window Header() + Recsize() * Reccount() + 1

Salvare setari de retea

* Salvare
NetSh Dump > my_Network_cfg.txt

*Restaurare

NetSh Exec my_Network_cfg.txt

Obtinere inregistrari care nu se regasesc in alt tabel

Select * From Tabla1 ;    WHERE Not Exists ;
   (Select * From Tabla2 ;
   WHERE Tabla1.Id = Tabla2.Id)

sau

Select * From Tabla1 ;    Where Id Not In (Select Id From Tabla2)

Obtinere zecumale dintr-un numar

Function GetDecimals(tnDecimal  As Decimal) As Decimal
    Return tnDecimal - Int(tnDecimal)
EndFunc

Afisare CheckBox in Raport

Iif(CampLogic, Chr(0xFD), Chr(0xA8))

Public oForm
oForm=CreateObject("form1")
oForm.Show
Define Class form1 As Form
Top = 0
Left = 0
Height = 520
Width = 790
DoCreate = .T.
Name = "Form1"

Add Object Graf As OleControl With ;
Top = 10, ;
Left = 5, ;
Height = 500, ;
Width = 780, ;
Name = "Graf", ;
OleClass = "MSChart20Lib.MsChart"

Procedure Init
Text to _cliptext noshow
X1 X2 X3 X4
25 35 15 25
EndText
This.Graf.Editpaste
#Define VtChChartType2dPie 14
This.Graf.ChartType = VtChChartType2dPie
This.Graf.ShowLegend = .T.
This.Graf.TitleText = "Titul Graficului"
EndProc
EndDefine

Utilizare ADOX pentru a adauga un tabel DBF la o baza de date MsAcces

Cat = CreateObject("ADOX.Catalog")
oTab = CreateObject("ADOX.Table")
cPathDB = "Provider=Microsoft.Jet.OLEDB.4.0;"+ "Data Source=C:\BaseDatos.mdb;"
* Deschidere catalog
oCat.ActiveConnection = cPath
* Creare tabel nou
With oTab
.Name =
"Linked Table dBASE"
.ParentCatalog = oCat
EndWith

* Setarea proprietatilor pentru a crea legatura cu tabela dBASE
With oTab
.Properties("Jet OLEDB:Link Datasource") = "C:\"
.Properties("Jet OLEDB:Remote Table Name") ="vacunas#dbf"
.Properties("Jet OLEDB:Create Link") = .T.
.Properties("Jet OLEDB:Link Provider String") = "dBASE 5.0;"
EndWith


* adaugare tabel la colectia Tabele
oCat.Tables.Append(oTbl)
oCat = Null
=MessageBox("Legatura tabelului a reusit.")

Refresh form cu API

#Define RDW_INVALIDATE 0x0001
#Define RDW_INTERNALPAINT 0x0002
#Define RDW_ERASE 0x0004
#Define RDW_VALIDATE 0x0008
#Define RDW_NOINTERNALPAINT 0x0010
#Define RDW_NOERASE 0x0020
#Define RDW_NOCHILDREN 0x0040
#Define RDW_ALLCHILDREN 0x0080
#Define RDW_UPDATENOW 0x0100
#Define RDW_ERASENOW 0x0200
#Define RDW_FRAME 0x0400
#Define RDW_NOFRAME 0x0800

*Wait Window Bitor(RDW_NOFRAME ,Bitor(RDW_FRAME ,Bitor(RDW_ERASENOW,RDW_ALLCHILDREN )))

Declare Integer RedrawWindow In WIN32API As ApiRedrawWindow ;
Integer HWnd, ;
Integer nUpdateRect, ;
Integer nUpdateRegion, ;
Integer nFlags

ApiRedrawWindow(ThisForm.HWnd, 0, 0, RDW_INTERNALPAINT + RDW_ALLCHILDREN + RDW_UPDATENOW)

Clear Dlls 'ApiRedrawWindow'

Executarea unei comenzi MSDOS fără a arăta fereastra

Declare Long WinExec In kernel32 STRING lpCmdLine, Long nCmdShow

cCmd = "RegSvr32.exe micontrol.ocx"

=WinExec(cCmd, 0)

Restartare PC

Declare SetupPromptReboot In setupapi.dll ;    Long FileQueue, 
    Long Owner, 
    Long ScanOnly

* Pentru reboot cu aprobarea utilizatorului
SetupPromptReboot (0, _Screen.hWnd, 0)

* Pentru reboot fortat
SetupPromptReboot (0, _Screen.hWnd, 1)

Descarcare fisierer de pe Iinternet

Declare DoFileDownload In  shdocvw.Dll STRING lpszFile

Local lcFile As String

*lcFile = "expertsoft.eu/versiuni.txt"

lcFile = "update.expert-net.ro/IcasUpdate/versiuni.txt"

DoFileDownload(StrConv(lcFile, 12))

Sau

oInet = Create("InetCtls.Inet")
oInet.RemotePort = "8080"
oInet.RequestTimeOut = 1000
* oInet.Proxy = "192.168.6.3"
cUrl = "http://update.expert-net.ro/IcasUpdate/versiuni.txt"
oDatos = oInet.OpenURL(cUrl, 1)
StrToFile(oDatos, 'sterge.txt')
Modify File Sterge.txt

Verifica daca exista conxiune de Internet

Local lOnline
oShell = CreateObject("WScript.Shell")
lOnline = oShell.Run("ping www.google.com",0,"True")
If lOnline = 0
MessageBox("ping OK!")
Else
MessageBox("ping Error!")
EndIf

VFP 10 ?

http://www.visual-freepro.org

Solutie de intretinere SQL Server

SQL Server Maintenance Solution

VFP desktop with icon like Window

http://www.ezcellpos.com/interactivesearch.html

VFP search like google

http://www.ezcellpos.com/interactivesearch.html

CheckBox in Grid Header

Local oForm As Form
oForm = CreateObject('HeaderCheckForm')
oForm.Show(1)
Return

Define Class HeaderCheckForm As Form
AutoCenter = .T.
Width = 500
Height = 600
MinWidth = 200
MinHeight = 100

Procedure Load
Create Cursor temp (f1 L, f2 L, f3 L, f4 C(30))
Local i
For i = 1 To 30
Insert Into temp Values (i%2=0, i%3=0, i%4=0, Replicate(Transform(i),10))
EndFor
Go Top In temp
EndProc

Add Object grdTest As Grid With ;
Left = 10, Top = 10, Width = 480, Height = 580, ;
DeleteMark = .F., RecordMark = .F., ;
Anchor = 15, RecordSource = 'temp'
Procedure grdTest.Init
Store 75 To This.Column1.Width, This.Column2.Width, This.Column3.Width

Local loColumn As Column, loCheckbox As Checkbox
For Each loColumn In This.Columns
If Type('Evaluate(m.loColumn.ControlSource)') = 'L'

* Add Header CheckBox
*!* loColumn.Header1.Caption = ""
loColumn.AddProperty('myCheckbox',Sys(2015))
ThisForm.NewObject(m.loColumn.myCheckbox,'HeaderCheckbox')
loCheckbox = GetPem(ThisForm,m.loColumn.myCheckbox)
loCheckbox.cColumnName = 'ThisForm.grdTest.' + m.loColumn.Name
loCheckbox.AfterInit()
loCheckbox.Visible = .T.

* Add Column CheckBox
loColumn.AddObject('Check1','Checkbox')
With loColumn.Check1 As Checkbox
.Caption = ""
.Visible = .T.
EndWith
loColumn.CurrentControl = 'Check1'
loColumn.Sparse = .F.

EndIf
Next
EndProc
EndDefine

Define Class HeaderCheckbox As Checkbox
Caption = ""
Value = .F.
Width = 15
cColumnName = ""

Procedure AfterInit
Local llSuccess, lcErrorMessage, ;
loColumn As Column, ;
loGrid As Grid, ;
loException As Exception
llSuccess = .T.
lcErrorMessage = ""
Try
loColumn = Evaluate(This.cColumnName)
loGrid = m.loColumn.Parent
For Each loColumn In m.loGrid.Columns
BindEvent(m.loColumn,'Resize', This,'AutoPos')
BindEvent(m.loColumn,'Moved', This,'AutoPos')
BindEvent(m.loColumn.Header1,'Click', This,'AutoPos')
BindEvent(m.loColumn.Header1,'MouseDown', This,'AutoPos')
BindEvent(m.loColumn.Parent,'Scrolled', This,'AutoPos')
Next
Catch To loException
llSuccess = .F.
lcErrorMessage = m.loException.Message
EndTry
Assert m.llSuccess Message m.lcErrorMessage

If m.llSuccess
BindEvent(ThisForm,'Resize', This,'AutoPos')
This.AutoPos()
EndIf
EndProc

Procedure AutoPos(dummy1, dummy2, dummy3, dummy3) && dummies for BindEvent("MouseDown"/"Scrolled")

Local ;
llSuccess, lcErrorMessage, ;
loColumn As Column, loGrid As Grid, ;
lnTop, lnLeft, ;
loException As Exception
llSuccess = .T.
lcErrorMessage = ""
Try
loColumn = Evaluate(This.cColumnName)
loGrid = m.loColumn.Parent
lnTop = m.loGrid.Top + 2
lnLeft = ObjToClient(m.loColumn, 2)
If m.lnLeft > 10
lnLeft = m.lnLeft + m.loColumn.Width - This.Width * 2
EndIf

If Between(m.lnLeft, 11,m.loGrid.Width - SysMetric(5))
This.Visible = .T.
This.Move(m.lnLeft,m.lnTop)
Else
This.Visible = .F.
EndIf
Catch To loException
llSuccess = .F.
lcErrorMessage = m.loException.Message
EndTry
Assert m.llSuccess Message m.lcErrorMessage
EndProc

Procedure Valid
Local loColumn As Column, lcAlias, lnRecNo
loColumn = Evaluate(This.cColumnName)
lcAlias = GetWordNum(m.loColumn.ControlSource,1,'.')
lnRecNo = RecNo(m.lcAlias)
Replace (m.loColumn.ControlSource) With This.Value All In (m.lcAlias)
Go Record (m.lnRecNo) In (m.lcAlias)

ThisForm.SetAll('lAutoPos',.T.)
EndProc

Procedure Destroy
UnBindEvents(This)
EndProc

lAutoPos = .F.
Procedure lAutoPos_assign(tlNewVal)
If m.tlNewVal
This.AutoPos()
EndIf
EndProc
EndDefine

Stocare Online in Cloud

In loc de folosirea stickurilor am inceput sa folosesc drive-uri online free ca
 Google Drive (5 GB), www.opendrive.com (5Gb),  Microsoft SkyDrive, SugarSync (125 MB), etc

Expert Software Company

Expert Software Company:

'via Blog this'

Registru Inventar OBLIGATORIU

Registrul-inventar constituie document contabil obligatoriu, în care se înregistreaza toate elementele de activ şi de pasiv, grupate în funcţie de natura lor, inventariate de unitate, adică listele de inventariere sau alte documente care justifică conţinutul acestora.

Potrivit legii, registrul-inventar se întocmeşte:  

1. la înfiinţarea unităţii  cel putin o dată pe an pe parcursul funcţionării unităţii  
2. cu ocazia fuziunii, divizării sau încetării activităţii  
3. alte situatii prevăzute de lege

Odată întocmit, parafat şi înregistrat în evidenţa unităţii, registrul-iventar se arhivează la compartimentul financiar-contabil şi se păstrează în unitate timp de 10 ani de la data încheierii exerciţiului financiar în cursul căruia a fost întocmit.

http://expertsoft.eu

Pagina de google plus

Pagina Google +

Ultima zi pentru depunerea bilanturilor pentru anul fiscal 2011 este 29 Mai

Anul 2012 este primul an in care bilantul se depune in format PDF inteligent cu arhiva atasata. Arhiva contine: procesul verbal de aprobare al bilantului, declaratia pe propria raspundere a administratorului, raportul de gestiune al administratorului, propunerea de distribuire a profitului sau de acoperire a pierderilor, note contabile. Toate societatile (societati comerciale, societati/companiile naţionale, regii autonome, institutele naţionale de cercetare-dezvoltare) sunt obligate la depunerea bilantului anual (inclusiv cele care nu au avut activitate in 2011), exceptie fac cei care au primit in prealabil derogare de la Administratia Financiara. Baza Legala - Legea 82/1991, cu modificările şi completările ulterioare. Ultimele formulare ANAF. Codificarea tipurilor de situatii financiare si raportari anuale.. ICAS - Program de contabilitate gratuit

ICAS: Cand folosim modulul de Note Contabile in programul de contabilitate?

Conform ORDIN nr. 1.850 din 14 decembrie 2004 privind registrele şi formularele financiar-contabile la pct. 7 din Anexa 1 NORME METODOLOGICE DE ÎNTOCMIRE ŞI UTILIZARE A REGISTRELOR ŞI FORMULARELOR COMUNE PE ECONOMIE PRIVIND ACTIVITATEA FINANCIARĂ ŞI CONTABILA În cazul operatiuniunilor contabile pentru care nu se întocmesc documente justificative, înregistrările în contabilitate se fac pe baza de note de contabilitate care au la baza note justificative sau note de calcul, după caz. ... Corectarea înregistrărilor făcute în contabilitate se face numai pe baza notelor de contabilitate întocmite în acest scop. De regula se foloseste pentru operatiunile care nu au la baza documente justificative(stornari, reglari, inchideri contabile, etc.) Descarca gratuit programul de la http://expertsoft.eu

VFP Windows Script

Examples of Window Scripting uses in VFP

This requires a Windows Scripting version 5.6 or more.
http://msdn.microsoft.com/library/default.asp?url=/downloads/list/webdev.asp.

How to get basic computer information
CODE
WshNetwork = CreateObject('WScript.Network')
lcMessage='Domain = ' + WshNetwork.UserDomain + CHR(13)
lcMessage=lcMessage+ 'Computer Name =' + WshNetwork.ComputerName+CHR(13)
lcMessage=lcMessage+ 'User Name = ' + WshNetwork.UserName
MESSAGEBOX(lcMessage)

How to get more information about your CD-ROM(s)
CODE
LOCAL strComputer
Local lcString
strComputer = '.'
lcString = '
objWMIService = Getobject('winmgmts:'+ 'impersonationLevel=impersonate}!\\' + strComputer + '\root\cimv2')
colItems = objWMIService.ExecQuery('Select * from Win32_CDROMDrive')
For Each objItem In colItems
lcString = lcString + 'Description: '+objItem.Description+Chr(13)
lcString = lcString + 'Name: '+objItem.Name+Chr(13)
lcString = lcString + 'Manufacturer:' +objItem.manufacturer+Chr(13)
lcString = lcString + 'Media type: '+objItem.mediaType+Chr(13)
lcString = lcString + 'PNP Device ID:' + objItem.PNPDeviceID +Chr(13)
Next
Messagebox(lcString)

How to map a Network Drive
CODE
oNet = CreateObject('WScript.Network')
oNet.MapNetworkDrive('I:','\\myserver\myFiles',.T.,'mike','password')

How to remove a Network connection
CODE
WshNetwork = CreateObject('WScript.Network')
WshNetwork.RemoveNetworkDrive('E')

How to add a printer connection
CODE
oNet = createobject('WScript.Network')
oNet.AddWindowsPrinterConnection('\\ServerName\PrinterName')

How to set a Windows default printer
CODE
oNet = CreateObject('WScript.Network')
oNet.SetDefaultPrinter('\\ServerName\PrinterName')

How to check for available space on a given disk drive.
CODE
objFSO = CreateObject('Scripting.FileSystemObject')
objDrive = objFSO.GetDrive('C:')
MESSAGEBOX('Available space: ' + chr(13)+TRANSFORM(objDrive.AvailableSpace,'999,999,999,999,999'+' kb' ))

How to copy a file
CODE
FSO = CreateObject('Scripting.FileSystemObject')
FSO.CopyFile('c:\COMPlusLog.txt','c:\x\')

How to create a folder
CODE
fso = createobject('Scripting.FileSystemObject')
fldr = fso.CreateFolder('C:\MyTest')

How to delete a folder
CODE
fso =createobject('Scripting.FileSystemObject')
fldr = fso.DeleteFolder('C:\MyTest')

How to determine if a folder exists.
CODE
fso =createobject('Scripting.FileSystemObject')
? fso.FolderExists('C:\MyTest')

How to create a file
CODE
fso = CreateObject('Scripting.FileSystemObject')
f1 = fso.CreateTextFile('c:\testfile.txt', .T.)

How to create a file and write to it.
CODE
fso = CreateObject('Scripting.FileSystemObject')
tf = fso.CreateTextFile('c:\testfile.txt', .t.)
tf.WriteLine('Testing 1, 2, 3.')
tf.WriteBlankLines(3) && Skip three lines
tf.Write ('This is a test.')
tf.Close
MODIFY FILE 'c:\testfile.txt'

How to create a desktop icon (with path)
CODE
oShell = CreateObject('WScript.Shell')
DesktopPath = oShell.SpecialFolders('Desktop')
oURL = oShell.CreateShortcut(DesktopPath + '\MSDN Scripting.URL')
oURL = oShell.CreateShortcut(DesktopPath + '\MSDN Scripting.URL')
oURL.TargetPath = 'HTTP://MSDN.Microsoft.com/scripting/'
oURL.Save

How to create an entry in the Windows' registry
CODE
oSh = CreateObject('WScript.Shell')
key = 'HKEY_CURRENT_USER\'
oSh.RegWrite( key + 'WSHTest\','testkeydefault')
oSh.RegWrite(key + 'WSHTest\string1', 'testkeystring1')
oSh.RegWrite( key + 'WSHTest\string2', 'testkeystring2', 'REG_SZ')
oSh.RegWrite( key + 'WSHTest\string3', 'testkeystring3', 'REG_EXPAND_SZ')
oSh.RegWrite( key + 'WSHTest\int', 123, 'REG_DWORD')

How to remove a Registry Key
CODE
oSh = CreateObject('WScript.Shell')
oSh.RegDelete('HKCU\\Software\\ACME\\FortuneTeller\\MindReader')
oSh.RegDelete('HKCU\\Software\\ACME\\FortuneTeller\\')
oSh.RegDelete ('HKCU\\Software\\ACME\\')

A replacement to the default VFP messagebox
CODE
WshShell = Createobject('WScript.Shell')
BtnCode = WshShell.Popup('Do you feel alright?', 7, 'Answer This Question:', 4 + 32)
Do Case
Case BtnCode=6
WSHSHELL.Popup('Glad to hear you feel alright.')
Case BtnCode=7
WSHSHELL.Popup('Hope you're feeling better soon.')
Endcase

Create a desktop shortcut
CODE
Shell = CreateObject('WScript.Shell')
DesktopPath = Shell.SpecialFolders('Desktop')
link = Shell.CreateShortcut(DesktopPath+'\test.lnk')
link.Arguments = '1 2 3'
link.Description = 'test shortcut'
link.HotKey = 'CTRL+ALT+SHIFT+X'
link.IconLocation = 'app.exe,1'
link.TargetPath = 'c:\blah\app.exe'
link.WindowStyle = 3
link.WorkingDirectory = 'c:\blah'
link.Save()

Use a Window XP fileOpen dialog (Only on Windows XP) that allows multiple selection.
CODE
oDlg= Createobject('userAccounts.commonDialog')
oDlg.flags= '&h1a04'
oDlg.Filter= 'All Files|*.*|'+ 'Text and Batch Files|*.txt;*.bat'
oDlg.filterIndex= 2
oDlg.initialDir='C:\'
qSln= oDlg.showOpen
If qSln
Messagebox(oDlg.fileName)
Else
Messagebox('Dialog cancelled.')
Endif

Demonstrates a method for converting the Universal Time Coordinate (UTC) values used by WMI to standard date-time values. This example returns the datetime in the installation of the Operating system.
CODE
strComputer = '.'
objWMIService = Getobject('winmgmts:\\' + strComputer + '\root\cimv2')
objOS = objWMIService.ExecQuery('Select * from Win32_OperatingSystem')
For Each strOS In objOS
dtmInstallDate = strOS.InstallDate
MESSAGEBOX(TRANSFORM(WMIDateStringToDate(dtmInstallDate)))
Next
Function WMIDateStringToDate(dtmInstallDate)
PRIVATE ldRetVal
RETURN CTOT(SUBSTR(dtmInstallDate, 5, 2) + '/' + SUBSTR(dtmInstallDate, 7, 2) + '/' + Left(dtmInstallDate, 4) + ' ' +;
SUBSTR(dtmInstallDate, 9, 2) + ':' + SUBSTR(dtmInstallDate, 11, 2) + ':' + SUBSTR(dtmInstallDate,13, 2))
ENDFUNC

Retrieving the local system time including day-of-the week,quarter, week-of-the-month
CODE
strComputer = '.'
lcStr='
objWMIService = Getobject('winmgmts:\\' + strComputer + '\root\cimv2')
colItems = objWMIService.ExecQuery('Select * from Win32_LocalTime')
Set Step On
For Each objItem In colItems
lcStr=lcStr+'Year: ' + Transform(objItem.Year)+Chr(13)
lcStr=lcStr+'Month: ' + Transform(objItem.Month)+Chr(13)
lcStr=lcStr+'Day: ' + Transform(objItem.Day)+Chr(13)
lcStr=lcStr+'Hour: ' + Transform(objItem.Hour)+Chr(13)
lcStr=lcStr+'Minute: ' + Transform(objItem.Minute)+Chr(13)
lcStr=lcStr+'Second: ' +Transform( objItem.Second)+Chr(13)
lcStr=lcStr+'Day Of the Week: ' + Transform(objItem.Dayofweek)+Chr(13)
lcStr=lcStr+ 'Week In the Month: ' +Transf( objItem.WeekInMonth)+Chr(13)
lcStr=lcStr+'Quarter: ' +Transform( objItem.Quarter)
Next
Messagebox(lcStr)

Run a schedule task now, rather than wait for the scheduled time.
CODE
ssfCONTROLS = 3 && Control Panel's Schedule Tasks folder
sJobName = 'fta' && Name of the task to run
sRunVerb = 'R&un' && Executing command
sEndVerb = '&End Task' && Cancelling command
shellApp = Createobject('shell.application')
oControlPanel = shellApp.Namespace(ssfCONTROLS) && Schedule Tasks folder
oST = '
For Each folderitem In oControlPanel.items && Loop though the items in the Control Panel items
If folderitem.Name = 'Scheduled Tasks'
oST = folderitem.getfolder() && Found it
Exit
Endif
Next
If Vartype(oST) != 'O'
Messagebox('Couldn't find 'TS' folder')
Endif
oJob = '
For Each folderitem In oST.items && Loop through the different scheduled tasks until we fiind it.
If Lower(folderitem.Name) = Lower(sJobName)
oJob = folderitem && Found it
Exit
Endif
Next
If Vartype(oJob) !='O'
Messagebox( 'Couldn't find ' + sJobName + ' item')
Else
bEnabled = .T.
oRunVerb = '
oEndVerb = '
s = 'Verbs: ' + Chr(13)
For Each Verb In oJob.verbs && Loop through the different commands in the scheduled task until we find right one.
s = s + Chr(13) + Verb.Name
If Verb.Name = sRunVerb
oRunVerb = Verb
bEnabled = .F.
Endif
If Verb.Name = sEndVerb
oEndVerb = Verb
Endif
Next
If bEnabled
oJob.InvokeVerb(oEndVerb) && Cancel the task
Else
Wait Window Nowait 'executing job'
oJob.InvokeVerb(sRunVerb) && Run the task!
Endif
Endif

Funtion to enumerate running processes.
CODE
FUNCTION enumerateProcess
lcComputer = '.'
loWMIService = Getobject('winmgmts:' ;
+ '{impersonationLevel=impersonate}!\\' + lcComputer + '\root\cimv2')
colProcessList = loWMIService.ExecQuery ;
('Select * from Win32_Process')
Create Cursor Process (Name c(20),Id i,Thread i,pagefile i,pagefault i,workingset c(20))
Index On Name Tag Name
For Each loProcess In colProcessList
Insert Into Process (Name,Id,Thread,pagefile,pagefault,workingset);
VALUES (loProcess.Name,loProcess.ProcessID,loProcess.ThreadCount,loProcess.PageFileUsage,;
loProcess.pagefaults,loProcess.WorkingSetSize)
Next
BROWSE normal
Function to terminate all instances of a running process.
CODE
FUNCTION terminateProcess(lcProcess)
lcComputer = '.'
loWMIService = Getobject('winmgmts:' ;
+ '{impersonationLevel=impersonate}!\\' + lcComputer + '\root\cimv2')
colProcessList = loWMIService.ExecQuery ;
('Select * from Win32_Process')
For Each loProcess In colProcessList
IF UPPER(loProcess.name) = lcProcess
loProcess.terminate()
endif
Next

How to force the Addprinter applet from the control Panel
CODE
oShell = CreateObject("WScript.Shell")
oShell.Run("rundll32.exe shell32.dll,SHHelpShortcuts_RunDLL AddPrinter")

How to access the Control Panel applets
CODE
oShell = CreateObject('WScript.Shell')
oShell.Run('Control.exe Sysdm.cpl,,0') && System Propeties general Tab.
oShell.Run('Control.exe Sysdm.cpl,,1') && System Properties - Computer name tab.
oShell.Run('Control.exe Sysdm.cpl,,2') && System properties - Hardware tab.
oShell.Run('Control.exe Sysdm.cpl,,3') && System properties - Advanced tab.
oShell.Run('Control.exe Sysdm.cpl,,4') && System properties - System Restore tab (ME and XP).
oShell.Run('Control.exe Sysdm.cpl,,5') && System properties - Automatic Updates tab.
oShell.Run('Control.exe Sysdm.cpl,,6') && System properties - Remote tab.

The parameters apply to the different applets. The last parameter refers to the tab that has the focus.

CODE
oShell.Run('Control.exe Access.cpl,,1') && Accessibilty Options applet focused on tab 1
oShell.Run('Control.exe AppWiz.cpl,,1') && Add/Remove Programs applet focused on tab 1
oShell.Run('Control.exe Desk.cpl,,1') && Display Properties applet focused on tab 1

Actualizare ICAS program de contabilitate

Update ICAS - v. 1.0.74 din 15.Mai.2012 [ Trezorerie ] • S-au inclus si conturile [5191] si [5192]. • In Tollbarul de operatiuni a aparut un buton de optiuni(customizare) util atunci cand ecranul se micsoreaza mai mult decat dimensiunea toolbarului. [ Facturi iesire valuta ] • zile scadente afisate pe raportul factura este minimul dintre zile scadenta setate in ecranul terti si diferenta de zile dintre data scadenta si data facturii. [ Salarii ] • Revizuit sume deductibile centralizator lichidare. • Revizuit nota contabila ( defalcat impozit din CM ). Istoricul versiunilor poate fi vizualizat la http://expertsoft.eu

Icas - program contabilitate gratuit

http://expertsoft.eu/news.php

Program de contabilitate gratuit ICAS cu baze de date SqlServer. http://expertsoft.eu/news.php