Grid Reconstruction

1. Grid reconstructs self always when RecordSource alias closed. If this is a view, reconstruction usually do not happens when you requery view, however, there are some reports that this could happen, so test carefully your application to see if view requery do not cause the grid reconstruction. If it is SQL statement, it happens when you assing anotehr SQL statement or just close alias used to store results of the query for grid. It also happens when you use SQL Pass-Through to query data into the alias that used as a record source of grid.

To avoid reconstruction when refreshing grid's record source, you require to assign empty string (not a one space - " ", but empty string - "") to the Record source before any of grid's record source refresh actions described above. If you already do that, just check your code if you do that in correct order or any other thing does not spoil the correct order of refreshing process. After refresh assign record source to grid again. Reconstruction in such case does not happen, however, another problem arises - all grid's columns re-bound to the control sources automatically by the phisical fields order. Following is a sample of how to fix that by little of code.

* remember control sources in the column's comment field
with {grid}
local nColumnIndex
for m.nColumnIndex = 1 to .ColumnCount
.Columns(m.nColumnIndex).Comment = .Columns(m.nColumnIndex).ControlSource
endfor
* prepare grid for refreshing of the Record Source
.RecordSource = ""
endwith
* do refreshing of the record source
...........
with {grid}
* restore record source
.RecordSource = "{RecordSourceName}"
* restore control sources
for m.nColumnIndex = 1 to .ColumnCount
.Columns(m.nColumnIndex).ControlSource = .Columns(m.nColumnIndex).Comment
endfor
endwith
In above code {grid} is a reference to the grid object, {RecordSourceName} is a name of the alias used as a record source or SQL statement.

Significant note: do not do any refreshing of the visible controls or grid on the form after statement 'RecordSource=""' and up to full restore of the control sources. Otherwise you will meet a problem with the error message like 'Type is not supported by control' in case you use costom controls in grid columns. This because after spoiling control sources incorrect field types might be used for column. For example, when you have a checkbox in the grid column, after refresh of record source column with checkbox often get a character field control source. If then you refresh a grid, you will get an error or something weird might happen like crashes or bad refresh.

With views, this is the most common situation because grid used often to display data dynamically, so it requires to be refreshed by another data. REFRESH() command for view does not cause reconstruction, however it could be used to refresh data only record-by record. For real refresh requery is needed. The main mistake here also is just requery view and leave it as is. Its a single command, so programmers often do this in many places without aware that they're doing something bad. After that, when reconstruction behavior observed for some view requery, programmer starts to find all places where this view is requeried. It might be in many places across forms and classes that starts to be a big problem. Tip: put data requery (and all other actions with data) in one place - class method or function. Always suggest that any data function might require in future some additional code, even when it is as simple as a requery of view. This way you will help youself to save a time to find all places where some action done with data in case you need to modify something. Grid reconstruction is one of such cases that you cannot avoid when it appears.

NEW!
Another approach to prevent grid reconstruction is to use BeforeRowColChange event of the grid.
BeforeRowColChange event is fired each time when grid is going to be reconstructed. It happens in any case include when grid alias closed, view requeried etc. despite grid visibility, focus and grid configuration. The most amazing is that putting NODEFAULT in this event for duration of data changes prevents grid reconstruction at all! Example:

thisform.GridRefreshing = .T. && tell all grid controls that grid data going to be requeried
... do data requery
thisform.Grid.RecordSource = thisform.Grid.RecordSource
thisform.Refresh && or grid refresh
DOEVENTS
&& after this moment grid stops to reconstruct self
thisform.GridRefreshing = .F.
In the BeforeRowColChange of grid class event put following:
if PEMStatus(thisform,"GridRefreshing",5) AND thisform.GridRefreshing
nodefault
return
endif
You can put above code in the grid class so this functionality will be generic.

The best thing is that this method do not require to organize restoring of the control sources of all columns. However, sometimes ot is require to set focus outside of grid and set it back to grid, because the current cell in grid might show asterisks ('*******') when avoiding reconstruction this way.

Unfortunately, there are no way to know the reason why BeforeRowColChange event is called to distinguish if it is called for recornstruction or it is called for movement between cells or some other actions with grid. Just use a flag for that as in the sample.

2. Reconstruction happens when grid is initialized and record source property is empty or record source does not exists (alias is not open). In this case grid reconstructs self and use current alias as a record source if opened (or keep self empty if no alias opened in current workarea, but all columns destroyed anyway). If you need to open record source in some other event than Load event of the form (before grid initializing), use following technique.

In the Load event of form create an empty cursor with the same structure as a record source for grid; record source property of grid should use that empty cursor. Then, when you open real data, assign empty string to grid's record source, open data and then assign again real data alias as described in the paragraph 1. For case you need a generic container with grid, put an invisible custom control that will create empty cursor in its Init event. However, assure that Init event of that control fires BEFORE Init event of the grid, otherwise reconstruction will happen.

3. Grid reconstructs self when column count changed to 0 or -1. I hope you never do this, do you? ;)

4. Grid reconstructs self when alias used as record source and it goes out of scope. This usually happens when record source assigned in one data session, but grid really initialized in another
data session, so when it tries to refresh self, another data session used where record source does not exists. This may occur also in other situations when programmer uses data sessions switching extensively.

Another popular approach to eliminate the grid reconstruction problem is dynamic grid creation. Make a custom grid class with all your code and columns definitions. When requery data, remove grid control from form, requery data, then add grid to form again in run-time. This requires to handle first adding of grid, set some properties of grid etc etc.

You can also create grid object in run-time and populate it by the custom controls using code. (Note that you can define custom header class.) However, after grid reconstructs self, you need to add these custom controls to grid again. This approach used in case when grid reconstruction is not avoidable, for example, in the administrative programs - to show any table content in the same grid, but also allow some functionality in grid like editboxes to see memo fields, sorting by click on headers etc. The sample code of creating grid in run-time and add some custom controls you can see in the FAQ#721

I hope this help you to figuire out a problem with your grid. Good luck and don't be frustrated, grid is very good control in VFP with no analogue!

Importing an Excel spreadsheet in VFP using Excel

De native IMPORT function of Visual Foxpro doesn't allways do a good yob. For example, sometimes it converts numbers to date values (01-01-1900).
The code below uses office automation to let Excel itself export the spreadsheet to dBase format. Also, you don't have to know in which version of Excel the spreadsheet is created, like you have to with the IMPORT function.

The code does not work with Excel 2007, because Microsoft decided to say bye bye to the dBase export filters.

Run the .PRG file like:

DO XLS2DBF WITH 'MySpreadsheet.xls', 'MyTable.dbf'

* XLS2DBF.PRG
*
* Function accepts 2 parameters
* 1) cSheet is the Excel sheet that is to be exported
* 2) cExportFile is the filename of the exportfile

PARAMETERS cSheet, cExportFile

IF PCOUNT() = 1
* Create a temp export file
cExportFile = SYS(2023) + "\" + SYS(3) + ".tmp"
ENDIF

LOCAL lErrorCatched, oExcelWorkbook, nFileFormat

nFileFormat = 11 && Excel Saveas constant for dBase IV format. Not available in Excel 2007 though...
lErrorCatched = .F.

* Can we get to Excel or what?
TRY
oExcelObject = CREATEOBJECT('Excel.Application')
CATCH
lErrorCatched=.T.
ENDTRY

IF lErrorCatched
RETURN .F.
ELSE

oExcelWorkbook = oExcelObject.Application.Workbooks.Open(cSheet)

* When columns in Excel are to small to show all the data, Excel also cuts them off when exporting!
* The code below formats the columns to be wide enough...
oExcelObject.Cells.Select
oExcelObject.Selection.Font.Size = 11 && dBase IV
oExcelObject.Selection.Columns.AutoFit
oExcelObject.Selection.Font.Size = 8

oExcelObject.cells(1).select && makes sure the whole sheet is exported and not some selected range (or whatever goes wrong with that from time to time...)
oExcelObject.DisplayAlerts = .F. && prevents overwrite message
oExcelWorkbook.SaveAs(cExportFile, nFileFormat)
oExcelWorkbook.close

* When opening a .DBF file created by Excel, there is no codepage
* VFP opens up the codepage dialog in order to choose a codepage, but we don't want that
* SET CPDIALOG OFF won;t help, because then there stil is no codepage for the .DBF file
* Luckily, VFP provides CPZERO.PRG, with can update a .DBF with a codepage
* You could do: DO CPZERO WITH cExportFile, 850
* But instead, the code below is a little piece of the CPZERO code that does the job, so we don't
* have to include CPZERO.PRG itself.
LOCAL varcpbyte, varfp_in, varbuf
varcpbyte = 2
varfp_in = FOPEN(cExportFile,2)
IF varfp_in > 0
* First check that we have a FoxPro table...
varbuf=FREAD(varfp_in,32)
IF (SUBSTR(varbuf,1,1) = CHR(139) OR SUBSTR(varbuf,1,1) = CHR(203);
OR SUBSTR(varbuf,31,1) != CHR(0) OR SUBSTR(varbuf,32,1) != CHR(0))
=fclose(varfp_in)
RETURN .F.
ELSE
* now poke the codepage id into byte 29
=FSEEK(varfp_in,29)
=FWRITE(varfp_in,CHR(varcpbyte))
=FCLOSE(varfp_in)
ENDIF
ELSE
RETURN .F.
ENDIF

* If no exportfile is specified, open the data as a temporary table to undertake further action
IF PCOUNT() = 1
cAlias = "C"+SYS(3)
USE (cExportFile) IN 0 ALIAS (cAlias)
* BROWSE NORMAL NOWAIT && if you want
ENDIF

* clean up Excel object
oExcelObject = .NULL.
RELEASE oExcelObject

Compara Versiuni SQL SERVER

http://www.microsoft.com/sqlserver/2008/en/us/editions-compare.aspx

Versiuni TRIAL Microsoft

http://www.microsoft.com/downloads/details.aspx?FamilyID=a9c110fd-aac8-4d2a-b401-7801b1866e82&displaylang=en

Send email via trigger

Usage:
Compile this project (http://www.divshare.com/download/7121306-6e1) using Visual Studio Express and place the DLL in the /lib/plugins directory. In MySQL;
create function SendMail returns string soname 'SendMail.dll';
select SendMail('to@address','from@address','Subject','Message','smtp.domain');

Despre Triggere Mysql

In definirea trigger-elor se folosesc două cuvinte rezervate MySQL, şi anume: OLD şi NEW.
Prin aceste două referinţe vă puteţi adresa la câmpurile din înregistrările care au fost sau urmează a fi procesate.
Astfel la o inserare în baza de date NEW va conţine toate câmpurile din înregistrarea pentru care a fost declanşat acel trigger, pe când la un trigger pe o instrucţiune UPDATE, în OLD veţi găsi toate informaţiile legate de înregistrarea ce a fost modificată.

Trigger-ii ajută la creşterea gradului de automatizare a unor procese, pot fi folosiţi foarte bine la logarea de date sau informaţii, ori folosit la crearea datelor de audit.
Nu în ultimul rând pot fi folosiţi şi la aplicarea unor restricţii suplimentare asupra operaţiunilor făcute asupra bazelor de date.
MySQL nu dispune de posibilitatea de a opri temporar triger-i asociat unei tabele, spre deosebire de MS SQL care poate dezactiva temporar trigger-ii.

Using REPLACE Statement to Add Data (MySQL)

REPLACE poate fi utilizat similar cu INSERT.
Principala diferenţă între cele două este modul in care sunt tratate valorile dintr-o coloană de tip cheie primară sau un index unic.

INSERT genereaza o eroare pentru valorile unice care există deja în tabel.
REPLACE sterge toate rândurile vechi şi adaugă un rând nou.

Nu uitati sa fiţi atent cand folositi comanda REPLACE. Puteţi suprascrie date importante.

MYSQL TimeStamp

Type: TimeStamp
Not Null: Bifat
Default: Bifat

Trigger Mysql Before DELETE

CREATE TRIGGER `articole_before_del_tr` BEFORE DELETE ON `articole`
FOR EACH ROW
BEGIN
IF EXISTS (SELECT CodArticol FROM miscari WHERE CodArticol = OLD.CodArticol) THEN
SELECT 0 FROM `Articolul are miscari. NU se poate sterge` INTO @error;
END IF;
END;


SAU

BEGIN
IF (SELECT COUNT(*) FROM miscari WHERE CodArticol=old.CodArticol)!=0
THEN
INSERT error_msg VALUES ('Foreign Key Constraint Violated!');
END IF;
END

Cum sa gasesc facturile neachitate in MySQL?

Table A has a list of all of my products and TABLE has a list of the products that each customer has purchased.

Table A
Product ID | Product Name

Table B
Cust_ID | Product_ID

SELECT a.ProductID, a.ProductName
FROM TableA AS a
LEFT JOIN TableB AS b ON a.ProductID = b.ProductID
AND b.CustID = $custid
WHERE b.ProductID IS NULL;

Detecting rightclick in an ActiveX Treeview control

LPARAMETERS tnButton, shift, x, y

#DEFINE MOUSE_LEFT 1
#DEFINE MOUSE_RIGHT 2
#DEFINE TwipsCalc 96*1440

IF tnButton == MOUSE_RIGHT

oNode=this.Hittest(x / TwipsCalc, y / TwipsCalc)

IF TYPE("oNode")="O" AND !ISNULL(oNode)
this.DropHighlight = oNode
WAIT WINDOW oNode.Text TIMEOUT .5
ENDIF

ELSE

DODEFAULT()

ENDIF

Intoarce numarul de inregistrari procesate sin SQL Server sau MySQL

CLEAR
SQLDISCONNECT(0)
lcConnStr = "Driver={SQL Server};Server=(local);Database=Gestiune2010;Trusted_Connection=Yes;"
lnConn = SQLSTRINGCONNECT(lcConnStr)

TEXT TO lcSQL NOSHOW TEXTMERGE PRETEXT 15
SELECT sItemCode, sDescription
FROM Items
WHERE sItemCode <> '00001'
ENDTEXT

SQLEXEC(lnConn, lcSQL, "tmpItems", laCount)
*WAIT WINDOW laCount(1,1)
WAIT WINDOW laCount(1,2) &&numarul de inregistrari INLOCUIESTE SELECT @@rowcount

*DISPLAY MEMORY LIKE laCount

RETURN

Obligatiile angajatului si angajatorului privind concediile medicale – precizari 19/05/2010

http://www.contabun.ro/2010/05/19/obligatiile-angajatului-si-angajatorului-privind-concediile-medicale-precizari/

Calendar declaratii, taxe si impozite 2010

http://www.contabun.ro/category/utile/calendar-declaratii-taxe-si-impozite/#mai

Optimizare Query MySQL

Utilitarul de optimizare a interogărilor din MySQL are numeroase scopuri, dar prima pala sa menire este de a folosi indexurile ori de câte ori este posibil, precum si de a folosi indexul cel mai restrictiv, pentru a elimina cât mai multe rânduri într-un timp cât scurt.
Poate părea ciudat, deoarece, atunci când emiteţi instrucţiuni SELECT, scopul dumneavoastră este de a găsi rânduri, nu de a le elimina. Motivul pentru care utilitarul optimizare funcţionează în acest mod este următorul:
- cu cât pot fi scoase din disc rânduri într-o manieră mai expeditivă, cu atât pot fi găsite mai rapid rândurile care satisfac criteriile de căutare.
Interogările pot fi prelucrate mai rapid dacă testele cele restrictive se pot efectua primele.

Să presupunem că aveţi o interogare care testează doua coloane, ambele coloane fiind dotate cu index:

WHERE coloana1 = "o valoare" AND cooana2 = "o alta valoare"

Să presupunem că testul aplicat asupra coloanei l găseşte 900 de rânduri, că testul aplicat asupra coloanei 2 găseşte 300 de valori, şi că ambele teste reuşesc în cazul a 30 de rânduri.
Dacă testaţi mai întâi coloana l, trebuie să examinaţi 900 de rânduri pentru a le găsi cele 30 care corespund şi valorii din coloana 2. Asta înseamnă 870 de teste ratate.
Daca testaţi mai întâi coloana 2, trebuie să examinaţi numai 300 de rânduri pentru a le găsi pe cele 30 care de asemenea corespund valorii din coloana 1. Numărul testelor ratate în; caz este de 270, ceea ce implică mai puţine calcule si operaţii de intrare-ieşire cu disc.

Puteţi ajuta utilitarul de optimizare să folosească indexurile folosind următoarele îndrumari:
- Comparaţi coloane de acelaşi tip.
Când folosiţi coloane indexate în comparaţii, utilizaţi coloane de acelaşi tip.
De exemplu, CHAR (10) este considerat identic VARCHAR(10), dar diferit de CHAR(12) sau
VARCHAR(12).
INT este diferit de BIGINT
Tipurile de coloane identice vă vor oferi performanţe superioare tipurilor de coloane diferite.

• Nu folosiţi caractere de înlocuire la începutul unui model LIKE. Uneori caută şiruri folosind o clauză WHERE de forma următoare:

WHERE nume_coloana LIKE "%sir

Aceasta este o operaţie corectă dacă doriţi să găsiţi şirul şir indiferent unde aplicati acesta în interiorul coloanei. Dar nu inseraţi caracterul % de ambele părţi doar din obişnuinţă.
Dacă într-adevăr căutaţi şirul numai atunci când acesta apare la începută coloanei, atunci nu mai scrieţi primul caracter %.
De exemplu, în cazul în care caut într-o coloană care conţine nume de familie acele nume care încep cu "Mac", scriu clauza WHERE astfel:

WHERE nume LIKE "Mac%"

Folosiţi coloane cu lungime fixă, nu coloane cu lungime variabilă. Acest lucru este valabil mai ales pentru tabelele care sunt modificate frecvent si care sunt, ca atare, supuse la fragmentare.
De exemplu, transformaţi toate coloanele caracter din VARCHAR in CHAR.
Compromisul este acela că tabelul dumneavoastră va folosi mult spaţiu, dar, dacă vă puteţi permite spaţiul suplimentar, rândurile cu lungime fixa pot fi prelucrate mai rapid decât rândurile cu lungime variabilă.

- Nu folosiţi coloane mai lungi atunci când se pot utiliza şi coloane mai scurte.
Dacă folosiţi coloane CHAR de lungime fixă, nu le faceţi inutil de lungi.
Dacă valoarea cea mai scurtă pe care o stocaţi într-o coloană este de 40 caractere, nu o declaraţi sub forma CHAR(255); declaraţi-o sub forma CHAR(40).
Dacă puteţi folosi MEDIUMINT în loc de BIGINT, tabelul dumneavoastră va fi mai mic (ceea ce implică mai puţine operaţii de intrare-ieşire cu discul), iar valorile vor fi prelucrate mai rapid în cadrul calculelor.

- Declaraţi coloanele ca NOT NULL. Astfel, obţineţi o viteză de prelucrare mai mare şi aveţi nevoie de un spaţiu de stocare mai redus. De asemenea, va simplifica uneori interogările, deoarece nu trebuie să trataţi NULL ca pe un caz special.

- Luaţi în calcul utilizarea de coloane ENUM.
Dacă aveţi o coloană şir care conţine numai un număr limitat de valori distincte, luaţi în considerare conversia acesteia la o coloană ENUM. Valorile ENUM pot fi prelucrate rapid, deoarece sunt reprezentate intern sub formă de valori numerice.

- Folosiţi PROCEDURE ANALYSE().
Dacă dispuneţi de MySQL versiunea 3.23 sau de o versiune ulterioară, rulaţi funcţia PROCEDURE ANALYSE() pentru a primi informaţii despre coloanele din tabelul dumneavoastră:

SELECT * FROM nume_tabel PROCEDURE_ANALYSE()
SELECT * FROM nume_tabel PROCEDURE_ANALYSE(16,256)

Una dintre coloanele datelor de ieşire este o sugestie a tipului optim de coloană pentru fiecare dintre coloanele tabelului dumneavoastră. Cel de-al doilea exemplu indică funcţiei PROCEDURE ANALYSE() să nu sugereze tipuri ENUM care conţin mai mult de 16 valori sau care ocupă mai mult de 256 octeţi (puteţi modifica valorile după cum doriţi). Fără asemenea restricţii, datele de ieşire pot fi foarte lungi declaraţiile ENUM sunt dese ori dificil de citit.

în funcţie de datele de ieşire ale funcţiei PROCEDURE ANALYSE(), puteţi descoperi că tabelul dumneavoastră poate fi modificat pentru a beneficia de un tip mai eficient.
Folosiţi ALTER TABLE dacă doriţi să modificaţi un tip de coloană.

- Folosiţi instrucţiunea OPTIMIZE TABLE pentru tabele supuse la fragmentare.
Utilizarea sistematică instrucţiunii OPTIMIZE TABLE contribuie la împiedicarea degradării performanţele tabelului.

Form fara Theme

Declare Integer SetWindowTheme In UxTheme INTEGER HWnd, String pszSubAppName, String pszSubIdList
=SetWindowTheme(Thisform.HWnd, Null, "")

Download de pe Net

Declare DoFileDownload In shdocvw.Dll STRING lpszFile
cRuta = "http://www.davphantom.net/archivo.txt"
DoFileDownload(Strconv(cRuta,12))

BURN CD From VFP

cDir =
GETENV("userprofile")+"\Configuración local\Application Data\Microsoft\CD Burning\"

cFile = "c:\DatosXP.txt"

Copy File (cFile) to (cDir+JustFname(cFile))

Partea zecimala a unui numar

nNum = 721.96841
? nNum - INT(nNum)

CheckBox in Raport

IIF(CampLogi, CHR(0xFD),CHR(0xA8))

Licenta MSMAPI.MAPISession

REGEDIT4


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

Dezactivare Windows Firewall

Run netsh firewall Set opmode Disable

Vizualizare imagine FullScreen

Run /N rundll32.exe shimgvw.Dll,ImageView_Fullscreen C:\Imagen.jpg

Activare Windows Desktop (ShowDesktop)

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

Numarul zecimalelor dintr-un numar

*nNumericValueWithDecimal = 12345.1234
*GetDecimalNo(nNumericValueWithDecimal) = 4

FUNC GetDecimalNo (nNumericValueWithDecimal)
nPos = At(".",Transform(nNumericValueWithDecimal))
RETURN IIF(nPos>0,Len(Substr(Transf(nNumericValueWithDecimal), nPos+1)),0)

Functia DayOfYear

FUNC DayOfYear
nZi = dDate - Date(Year(Date()), 1, 1) + 1
Return(nZi)

* Returneaza cate zile a trecut de la inceputul anului

AN bisect?

?Mod(2004, 4)

sau

?!Empty(Date(2004, 02, 29))

Alternativa Transfer DBF2XLS

oExcel = Createobject("Excel.Application")
oExcel.WorkBooks.Add

Use Home()+"samples\data\Customer"Shared
Set Talk Off

nNumRegExp = 15 && Reccount()

For i= 1 To nNumRegExp
For J = 1 To Fcount()
oExcel.ActiveSheet.cells(i,J).Value= Eval(Field(J))
Next
Skip
Next

oExcel.Visible= .T.

Enable / Disable Theme XP

Declare Integer EnableTheming In "UxTheme.dll" Integer nEnable

=EnableTheming(.F.)
Inkey(5, "H")
=EnableTheming(.T.)

Declare Integer IsThemeActive in "UxTheme.dll" () As Long
nRet = IsThemeActive()

? "Themes: " + Iif(nRet = 0, "Nu e activa","Activa")

GRID DynamicBackColor

LOCAL o
o = Createobject("myform")
o.Show(1)

Define Class myform As Form
DoCreate = .T.
DataSession = 2
AutoCenter = .T.
Caption = "Trabajando con DyamicBackGround"
Width = 600

Height = 400
MinHeight = 300
MinWidth = 300
Add Object grid1 As Grid With ;
HEIGHT = This.Height, ;
WIDTH = This.Width, ;
DELETEMARK = .F.

Procedure Load
Select * From (_samples+"datacustomer") ;
Order By MaxOrdAmt Desc;
Into Cursor TmpCust
Use In "customer"
EndProc

Procedure Init
This.grid1.SetAll("dynamicbackcolor",;
"Thisform.GetBackColor(allt(country))")
EndProc


Procedure Resize
This.grid1.Width= This.Width
This.grid1.Height= This.Height
EndProc

Function GetBackColor(cCountry)

Local nColor
Do Case
Case cCountry == "Germany"
nColor = Rgb(255,255,255)
Case cCountry == "UK"
nColor = Rgb(224,224,0)
Case cCountry == "Sweden"
nColor = Rgb(224,224,160)
Case cCountry == "France"
nColor = Rgb(100,224,160)
Case cCountry == "Spain"
nColor = Rgb(100,224,160)
Otherwise
nColor = Rgb(224,100,224)
EndCase
Return nColor
EndFunc
EndDefine

Verifica daca gridul are coloane ascunse

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

Grafic EXCEL

oExcel = CreateObject("Excel.Application")
oExcel.Workbooks.Add()

oSheet = oExcel.ActiveSheet

oSheet.Range("A1").Formula="Oscar"
oSheet.Range("A2").Formula="Maria"
oSheet.Range("A3").Formula="Juan"

oSheet.Range("A4").Formula="Pedro"
oSheet.Range("A5").Formula="Ana"
oSheet.Range("B1").Formula="435"

oSheet.Range("B2").Formula="213"
oSheet.Range("B3").Formula="592"
oSheet.Range("B4").Formula="150"

oSheet.Range("B5").Formula="97"

oChart = oSheet.ChartObjects.Add(150, 10, 200, 200)
oSheet.ChartObjects(1).Chart.ChartWizard(oSheet.range(oSheet.cells(1,1),oSheet.cells(5,2)),;
-4100,4,1,0,1,1,"","","","")


oExcel.Visible= .T.

Reordonare Controale in FORM

* Se creeaza metoda Reorder.

Lparameters oObj

Local oControl
For Each oControl In oObj.Objects
*Wait window oControl.Name
If Pemstatus(oControl, 'Objects', 5)
This.Reorder(oControl)
EndIf
EndFor

Se apeleaza pt un formular:

Thisform.Reorder(Thisform)
sau pentru un obiect de tip container

Thisform.Reorder(Thisform.PageFrame)

Explorer in VFP Form

Public oform1
oform1=Newobject("form1")
oform1.Show

Return

Define Class form1 As Form
DoCreate = .T.
Caption = "Explorer"
Name = "Form1"
HEIGHT = _Screen.Height - 2
Width = _Screen.Width - 2

Add Object ole1 As OleControl With ;
Top = 26, ;
Left = 0, ;
Height = _Screen.Height-4, ;
Width = _Screen.Width-4, ;
Name = "Ole1" ,;
OleClass = "Shell.Explorer.2"

Add Object command1 As CommandButton With ;
AutoSize = .T., ;
Top = 0, ;
Left = 0, ;
Height = 28, ;
Width = 114, ;
Caption = "Arata Continut FOLDER", ;
Name = "Command1"

Procedure Init
This.ole1.Object.Navigate2("file:///C:/")
EndProc

Procedure command1.Click
Local cDir
*cDir = Getdir(",",",2)
cDir = Getdir()
Thisform.ole1.Navigate2(cDir)
EndProc

ENDDEFINE

Dimensiuni imagine, pictura

oPict = LOADPICTURE(GetFile("Gif"))
? oPict.Height
? oPict.Width

Trucuri VFP

Un alt mod de a umple cu zerouri la un string. În exemplul de mai vreau să umple cu zerouri numărul 80.
? TRANSFORM(80,"@L 99999999")

Rezulta 00000080

Trucuri VFP

Puteţi obţine informaţii suplimentare despre configuraţia actuală a VFP.
Selectati meniul Tools, apoi selectaţi "Opţiuni" şi apăsaţi acum tasta SHIFT şi
faceţi clic pe OK, şi, în fereastra de comanda VFP veţi obţine toate informaţiile de configurare de la VFP.

Dezactiveaza serviciul THEMES pt XP

objWMI = GetObject("winmgmts:\")
cCadWMI = "Select * from Win32_Service Where Name = 'Themes'"
oServ = objWMI.ExecQuery(cCadWMI)

For Each objService in oServ
objService.StopService()
Next

*objService.StartService()

De cat timp este pormit 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

Alternativa API pt. functia LEN(). Tine pana la 255 caractere.

Declare Integer lstrlen IN kernel32 String lpString
WAIT WINDOW lstrlen("La Web de Davphantom asdasd asdas dasd asd asdasd asd asda sdasda sdasd asdasd asd asdasdasdasdasdasdasdas asdasdasdas La Web de Davphantom asdasd asdas dasd asd asdasd asd asda sdasda sdasd asdasd asd asdasdasdasdasdasdasdas sdasd asdasd asd aaaaaaa aaaa a" )

Indexare cu ActiveX Progress

PUBLIC oForm
oForm =CREATEOBJECT("Form")
SET TALK OFF
WITH oForm
.CAPTION=""
.AUTOCENTER= .T.
.WIDTH= 375
.HEIGHT= 31
.VISIBLE= .T.
.CONTROLBOX= .F.
.ADDOBJECT("oBarra","OleControl","mscomctllib.progctrl.2")
WITH .oBarra
.VISIBLE= .T.
.LEFT= 4
.TOP= 5
.WIDTH= 368
.HEIGHT= 20
.MIN= 1
ENDWITH
ENDWITH

CREATE CURSOR MiTabla (Campo C(12))
FOR i = 1 TO 10000
APPEND BLANK
ENDFOR

nTotReg =RECCOUNT("MiTabla")
LOCATE

oForm.oBarra.MAX= nTotReg
INDEX ON Progreso(Campo, RECNO(), nTotReg) TAG Campo
oForm.RELEASE

FUNCTION Progreso(Campo, nRecno, nTotReg)
cProg = TRANSFORM(ROUND((nRecno/nTotReg)*100,0)) +"%"
oForm.CAPTION="Progres " + cProg
oForm.oBarra.VALUE= nRecno
RETURN Campo
ENDFUNC

Informatii PROCESOR

? "Number CPUs: " +GETENV("NUMBER_OF_PROCESSORS")+CHR(13)
? "Arhitectura procesor : " +GETENV("PROCESSOR_ARCHITECTURE")+CHR(13)
? "Processor Id Identifier: " +GETENV("PROCESSOR_IDENTIFIER")+CHR(13)
? "Processor Level: "+GETENV("PROCESSOR_LEVEL")+CHR(13)
? "Processor Review Revision: " +GETENV("PROCESSOR_REVISION")+CHR(13)

Numere pentru LOTO 6/49

Do While nVueltas > nControl
cNum = Transform(Int(49 * Rand() + 1) )
nControl = nControl + 1
@Srows()/2, (Scols()/2 - (Len(cNum)/2))Say cNum Font "Tahoma",30 Style "B"
Enddo

WAIT WINDOW in centrul Ecranului

lcMess = "Mesaj Wait Window" + CHR(13) + [in mijlocul ecranului]
Wait Window lcMess At Srows()/2,(Scols()/2 - (Len(lcMess)/2))

Intoarce numarul de pagini dintr-un fisier WORD

FUNCTION WordPageCount(cWordDoc)
oWord = CreateObject("Word.Application")
oDoc = oWord.Documents.Open(cWordDoc)
oDoc.Repaginate

cPag = Transform(oWord.Selection.Information(4))
=Messagebox( "Documentul contine " + cPag + " pagini")
oWord.Quit
Release oWord

Calcul expresie cu ajutorul lui Excel

oExcel = CreateObject("Excel.Application")
nRes = oExcel.WorksheetFunction.STDev(85,90,62,100,39,84)
? nRes
Release oExcel

Verifica daca un SERVICIU de Windows RULEAZA

oShell = CREATEOBJECT("Shell.Application")
? oShell.IsServiceRunning("Mysql")

Opreste serviciul

?oshell.ServiceStop("mysql", .T.)

Porneste serviciul

?oshell.ServiceStart("mysql", .T.)

Decomprimare arhive ZIP

cZip = "C:\ruta\archiva.ZIP"
cDestino = "c:\temp\"

o=CREATEOBJECT("shell.application")
FOR EACH ofile IN o.NameSpace(cZip).items
o.NameSpace(cDestino).copyhere(ofile)
ENDFORjavascript:void(0)

Truc pentru a afisa numai zecimale dintr-un numar

? ABS(78.53) % 1

Detecteaza daca un Formular are ScrollBars

? Thisform.ViewPortHeight # Thisform.Height
? Thisform.ViewPortWidth # Thisform.Width

Serie Fabrica HDD

objWMI = Getobject("winmgmts:\\")
cCadWMI = "Select * from Win32_PhysicalMedia"
oSistema = objWMI.ExecQuery(cCadWMI)

For Each Disco In oSistema
? "Serie Fabrica :" + Disco.SerialNumber
NEXT
javascript:void(0)

Verifica daca este introdusa discheta in FLOPPY

objWMI = Getobject("winmgmts:\\")
cCadWMI = "Select * From Win32_LogicalDisk Where DeviceID = 'A:'"
objOper = objWMI.ExecQuery(cCadWMI)

For Each oDisk in objOper
nFree = oDisk.FreeSpace
If IsNull(nFree) Then
? "Nu exista discheta in unitate"
EndIf
Next

Informatii Discuri PC (HDD, DVD, FLOPPY)

objWMI = Getobject("winmgmts:\\")
cCadWMI = "Select FreeSpace,Size,Name From Win32_LogicalDisk"
objDisk = objWMI.ExecQuery(cCadWMI)

For Each Disk In objDisk
? "Disk: " + Disk.Name + " - Liber: " + Transform(Disk.FreeSpace) + " Total:" + Transform(Disk.Size)

NEXT

Creare, Stergere si Verificare Serviciu Windows

Creare Proces Windows

OWN_PROCESS = 16
NOT_INTERACTIVE = .F.
ControlError = 2 &&Normal
TipInicio = "Manual"
NomSer = "MyService"
NomMostrar = "Nombre para mostrar - MiServicio"

cRutaEXE = "c:\windows\system32\pd.exe"
cIniSesion = "NT AUTHORITY\LocalService"

objWMI = GetObject("winmgmts:\\")
objSer = objWMI.Get("Win32_BaseService")

errRet = objSer.Create(NomSer, NomMostrar, cRutaExe, OWN_PROCESS, ControlError,
TipInicio, NOT_INTERACTIVE, cIniSesion, "" )

? errRet


Eliminare serviciu Windows
objWMI = GetObject("winmgmts:\\")
cCadWMI = "Select * from Win32_Service Where Name = 'DbService'"
oServ = objWMI.ExecQuery(cCadWMI)

For Each miS in oServ
miS.StopService()
miS.Delete()
Next

Verificare Stare serviciu Windows

objWMI = GetObject("winmgmts:\\")
cCadWMI = "Select * from Win32_Service"
objSer = objWMI.ExecQuery(cCadWMI)

For Each oSys in objSer
? oSys.DisplayName + " " + oSys.State
Next

Dezinstalare Aplicatie Windows

objWMI = GetObject("winmgmts:\\")
cCadWMI = "Select * from Win32_Product Where Name = 'Nume Aplicatie'"
oColS = objWMI.ExecQuery(cCadWMI)

For Each oSoft in oColS
oSoft.Uninstall()
Next

Opreste Calculatorul

objWMI = GetObject("winmgmts:\\")
cCadWMI = "Select * from Win32_OperatingSystem"
oBServ = objWMI.ExecQuery(cCadWMI)

For Each Pc in oSys
Pc.Win32Shutdown(1)
Next

Restarteaza Calculatorul

objWMI = GetObject("winmgmts:\\")
cCadWMI = "Select * from Win32_OperatingSystem"
oBServ = objWMI.ExecQuery(cCadWMI)

For Each Pc in oSys
Pc.Reboot()
Next

Verifica daca SQL Server este instalat

objWMI = GetObject("winmgmts:\\")
cCadWMI = "Select * from Win32_Service Where Name = 'MSSQLServer'"
oBServ = objWMI.ExecQuery(cCadWMI)

If oBServ.Count > 0 Then
For Each objSer in oBServ
? "SQL Server is " + objSer.State + "."
Next
Else
? "SQL Server no este intalat pe acest calculator."
EndIf

SQL Server Backup

Local loserver, lnCounter, loBackupDevice

loserver=Createobject("SQLDMO.SqlServer")
loserver.Connect("MiServidor","MiUserName","MiPassword")

If loserver.BackupDevices.Count = 0
loBackupDevice = Createobject("SQLDMO.BackupDevice")

With loBackupDevice
.Name = "MyBackup"
.PhysicalLocation = "C:\MyBackups\BackupFile.bak"
.Type = 2 && SQLDMODevice_DiskDump
Endwith

loserver.BackupDevices.Add(loBackupDevice)
Else

For lnCounter = 1 To loserver.BackupDevices.Count
? loserver.BackupDevices(lnCounter).PhysicalLocation
Next lnCounter

Endif

Window Scripting

Examples of Window Scripting uses in VFP

Here are a few examples of the different uses of Window Scripting. 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 The rest of the Applets works in the same principle. InetCpl.cpl Internet Options Intl.cpl Country Joy.cpl Joystick mlcfg32.cpl Mail account setup Main.cpl Mouse, keyboard, printers and fonts MmSys.cpl Multimedia and sounds Modem.cpl Modem OdbcCp32.cpl ODBC data source Password.cpl Password Ports.cpl Ports PowerCfg.cpl Power Management PrefsCpl.cpl Real Player G2 Ras.cpl Remote Access SrvMgr.cpl Server SysDm.cpl System Telephon.cpl Telephony Themes.cpl Desktop themes TimeDate.cpl Date/Time TweakUI.cpl TweakUI Ups.cpl Spare power supply

Informatii Calculator

*WAIT WINDOW GetEnv("USERDOMAIN") = GETWORDNUM(SYS(0),1)

CLEAR

*!* Let's get the Free Physical Memory of local machine in KB
LOCAL loWMIService, loItems, loItem
loWMIService = GETOBJECT("winmgmts:\\.")
loItems = loWMIService.ExecQuery("Select * from Win32_OperatingSystem")
FOR EACH loItem IN loItems
? int(val(loItem.FreePhysicalMemory))
ENDFOR
*!* Let's get the CPU ID
LOCAL lcComputerName, loWMI, lowmiWin32Objects, lowmiWin32Object
lcComputerName = GETWORDNUM(SYS(0),1)
loWMI = GETOBJECT("WinMgmts://" + lcComputerName)
lowmiWin32Objects = loWMI.InstancesOf("Win32_Processor")
FOR EACH lowmiWin32Object IN lowmiWin32Objects
WITH lowmiWin32Object
? "ProcessorId: " + TRANSFORM(.ProcessorId)
ENDWITH
ENDFOR

?
?

*!* Let's get the MAC Address(es)
LOCAL lcComputerName, loWMIService, loItems, loItem, lcMACAddress
lcComputerName = "."
loWMIService = GETOBJECT("winmgmts:\\" + lcComputerName + "\root\cimv2")
loItems = loWMIService.ExecQuery("Select * from Win32_NetworkAdapter",,48)
FOR EACH loItem IN loItems
lcMACAddress = loItem.MACAddress
IF !ISNULL(lcMACAddress)
? "MAC Address: " + loItem.MACAddress
?
ENDIF
ENDFOR

?
?

*!* Let's get the Volume Serial Number(s)
LOCAL lcComputerName, loWMIService, loItems, loItem, lcVolumeSerial
lcComputerName = "."
loWMIService = GETOBJECT("winmgmts:\\" + lcComputerName + "\root\cimv2")
loItems = loWMIService.ExecQuery("Select * from Win32_LogicalDisk")
FOR EACH loItem IN loItems
lcVolumeSerial = loItem.VolumeSerialNumber
IF !ISNULL(lcVolumeSerial)
? "Name: " + loItem.NAME
? "Volume Serial Number: " + loItem.VolumeSerialNumber
?
ENDIF
ENDFOR

?
?

loWMIService = GETOBJECT("winmgmts:\\.")
loItems = loWMIService.ExecQuery("Select * from Win32_Processor")
*colItems = objWMIService.ExecQuery("Select * FROM Win32_Processor", 48)

For Each objItem In loItems
? objItem.Name
? ObjItem.CurrentClockSpeed

Next

Search Filenames with Wildcards in VFP using Script

In VFP, searching files using Wildcards can be done with
ADIR() function. However, there is also another method
aside from that and from using DIR/s which can also
yield the same result.

Search for files with filename AUTOEXEC which could have any
extension name.

MyScript = Createobject('Scripting.FileSystemObject')
loCollection = MyScript.GetFolder('C:\')

lcFileToSearch = 'AUTOEXEC' && Search for AUTOEXEC.*

For Each loObject In loCollection.Files
If Upper(Juststem(loObject.Name)) == Upper(m.lcFileToSearch)
? Upper(loObject.Name)
Endif
Endfor

Word in formular VFP

PUBLIC oform1
oform1=NEWOBJECT("form1")
oform1.Show
RETURN
DEFINE CLASS form1 AS form
Top = 0
Left = 0
Height = _screen.height - 2
Width = _screen.width - 2
DoCreate = .T.
Caption = "Word Document"
Name = "Form1"
WindowState = 2
ADD OBJECT txtframe AS textbox WITH ;
Enabled = .F., ;
Height = _screen.height - 2 , ;
Left = 4, ;
ReadOnly = .T., ;
Top = 4, ;
Width = _screen.width - 2, ;
Name = "txtFrame"
PROCEDURE Init
lcDoc = GETFILE('doc')
oForm = THISFORM
IF Vartype(oForm.oWordDoc)="O"
oForm.removeObject("oWordDoc")
CLEAR CLASS oleWordObject
ENDIF
oForm.AddObject('oWordDoc','oleWordObject')
oForm.oWordDoc.Height = THISFORM.txtFrame.height
oForm.oWordDoc.Width = THISFORM.txtFrame.width
oForm.oWordDoc.Top = THISFORM.txtFrame.top
oForm.oWordDoc.Left = THISFORM.txtFrame.left
oForm.oWordDoc.Visible = .t.
oForm.Show
oForm.oWordDoc.DoVerb(0)
ENDPROC
ENDDEFINE
DEFINE CLASS oleWordObject as OLEControl
OleClass ="Word.Document" && Server name
DocumentFile = lcDoc
ENDDEFINE

UserCmd

PROC UserCmd
* Creare formular cu caracteristicile unei ferestre PRG.
loForm = CreateObject('Form')
With loForm
.Caption = [Proceduri Utilizator]
.Width = _Screen.Width - 50
.Height = _Screen.Height - 50
.FontName = 'Courier New'
.FontSize = 10
EndWith

MODIFY COMMAND usercmd.prg WINDOW (loForm.Name)
EXECSCRIPT(FILETOSTR([usercmd.prg]))

Pentru probleme de afisare in Vista si Win 7

DEFINE CLASS VistaForm AS Form

PROCEDURE Init
DO CASE
CASE NOT OS(1) == "Windows 6.00"
* No Vista, no problem.
CASE EMPTY(SYS( 1271, m.Thisform ))
* No SCX form, no problem.
CASE m.Thisform.ShowWindow == 0 && In Screen.
ACTIVATE WINDOW (m.Thisform.Name) IN SCREEN NOSHOW
CASE m.Thisform.ShowWindow == 1 && In Top-Level Form.
LOCAL lcWindowName
lcWindowName = m.Thisform.GetTopLevelFormName()
ACTIVATE WINDOW (m.Thisform.Name) IN WINDOW (m.lcWindowName) NOSHOW
OTHERWISE && As Top-Level Form.
* Top-level forms are not affected.
ENDCASE
ENDPROC

PROCEDURE GetTopLevelFormName
* Get the top level form this form is
* running in (might be the Vfp Screen).
DECLARE INTEGER GetParent IN Win32Api INTEGER ThisHWnd
LOCAL lnParentHWnd, i, lcParentName
lnParentHWnd = GetParent(GetParent( m.Thisform.HWnd ))
IF INLIST( m.lnParentHWnd, _Vfp.HWnd, _Screen.HWnd )
lcParentName = "Screen"
ELSE
FOR i = 1 TO _Screen.FormCount
IF _Screen.Forms[ i ].HWnd == m.lnParentHWnd
lcParentName = _Screen.Forms[ i ].Name
EXIT
ENDIF
ENDFOR
ENDIF
RETURN m.lcParentName
ENDPROC

ENDDEFINE

*=======================================================
DEFINE CLASS VistaCombo AS Combobox

nOriginalColumnCount = -1

PROCEDURE Init
m.This.VistaBugWorkaround()
ENDPROC

PROCEDURE VistaBugWorkaround
* Only on Vista.
IF NOT OS(1) == "Windows 6.00"
RETURN
ENDIF
WITH This
* Remember original ColumCount.
IF .nOriginalColumnCount == -1 ;
AND .ColumnCount < 2
.nOriginalColumnCount = .ColumnCount
ENDIF
* Make sure ColumnCount >= 2.
DO CASE
CASE .RowSourceType == 1 && Value.
IF .ColumnCount < 2
.ColumnCount = 2
.ColumnLines = .F.
* Trigger RowSource_Assign().
.RowSource = .RowSource
ENDIF
CASE .RowSourceType == 5 && Array.
IF .ColumnCount < 2
.ColumnCount = 2
.ColumnLines = .F.
IF .ColumnWidths == ""
.ColumnWidths = LTRIM(STR( .Width ))
ENDIF
IF NOT "," $ .ColumnWidths
.ColumnWidths = .ColumnWidths + ",0"
ENDIF
ENDIF
CASE .RowSourceType == 6 && Fields.
IF .ColumnCount < 2
.ColumnCount = 2
.ColumnLines = .F.
ENDIF
ENDCASE
ENDWITH
ENDPROC

PROCEDURE RowSource_Assign
LPARAMETERS tcRowSource
WITH This
IF .RowSourceType == 1 ; && Value.
AND .ColumnCount == 2 ;
AND BETWEEN( .nOriginalColumnCount, 0, 1 )
.RowSource = STRTRAN( m.tcRowSource, ",", ",," ) + ","
ELSE
.RowSource = m.tcRowSource
ENDIF
ENDWITH
ENDPROC

ENDDEFINE
*=============================================================
In programul main al aplicatiei:

DECLARE integer GdiSetBatchLimit IN WIN32API integer
GdiSetBatchLimit(1)


In metoda INIT a formularului:

LOCAL lnBorderStyle

lnBorderStyle = this.BorderStyle

ACTIVATE WINDOW (THIS.NAME) IN SCREEN NOSHOW

this.BorderStyle = lnBorderStyle

Utilizare Command Prompt (cmd.exe) fara sa fie afisata fereastra pe Ecran

DECLARE INTEGER ShellExecute IN "shell32.dll";
INTEGER hwnd,;
STRING @ lpOperation,;
STRING @ lpFile,;
STRING @ lpParameters,;
STRING @ lpDirectory,;
INTEGER nShowCmd

ShellExecute( 0, "open", "c:\windows\system32\cmd.exe", "/c ping google.com > log.txt", "", 0 )

Alphanumeric key incrementing routine

* Creates next string key from the passed one using specified set of characters
*
* Parameters
* 1 - Current Key
* 2 - Defines the list of allowed characters
* BASEnn - See DO CASE in the body of the program
* CUSTOM - the list of character as parameter 3
* 3 - List of characters
*
* Returns Next key
*
* Note 1 Routine ignores (doesn't change) positions with the characters not in the specified list
* Note 2 When max possible value is reached, the next return value will be the min possible value
*

FUNCTION NextKey
LPARAMETERS tcOldVal, tcOpt, tcCharList
LOCAL lcNewVal, i, lcDigits, lcLetters, lnCharListLen, lcOldChar, lcNewChar, lcCharList, lnPos, lcOpt
LOCAL lnNextPos

lcOpt = IIF(EMPTY(tcOpt), "BASE10", UPPER(tcOpt))
* Get the list of appropriate characters
lcCharList = NextKeyFillCharList(lcOpt, tcCharList)
lnCharListLen = LEN(lcCharList)
lcNewVal = tcOldVal

* Scan string from the right to the left
FOR i = LEN(lcNewVal) TO 1 STEP -1

lcOldChar = SUBSTR(tcOldVal, i, 1)
* Is the current charater in the list?
lnPos = AT(lcOldChar, lcCharList)
IF lnPos = 0
* Not in the list, keep it
LOOP
ENDIF

* Get the next character position
lnNextPos = (lnPos % lnCharListLen) + 1
* Get the next character
lcNewChar = SUBSTR(lcCharList,lnNextPos,1)
* Stuff it back in the string
lcNewVal = STUFF(lcNewVal, i, 1, lcNewChar)
* Check if we have to carry over to the next position
IF lnNextPos > 1
* We are done
EXIT
ENDIF

ENDFOR

RETURN lcNewVal
*------------------------------------------------------------
* Fill the list of characters based on character set requested
FUNCTION NextKeyFillCharList
LPARAMETERS tcCharSet, tcCharList
LOCAL lcCharList, lcDigits, lcLetters
* Fill string 'lcCharList' with appropriate characters
lcDigits = "0123456789"
lcLetters = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"

DO CASE
CASE tcCharSet = "CUSTOM"
lcCharList = tcCharList
CASE tcCharSet == "BASE10"
* Just Digits
lcCharList = lcDigits
CASE tcCharSet == "BASE16L"
* Hexadecimal in lower case
lcCharList = lcDigits + "abcdef"
CASE tcCharSet == "BASE16"
* Hexadecimal in upper case
lcCharList = lcDigits + "ABCDEF"
CASE tcCharSet == "BASE26L"
* Lower case letters
lcCharList = LOWER(lcLetters)
CASE tcCharSet == "BASE26"
* Upper case letters
lcCharList = lcLetters
CASE tcCharSet == "BASE36L"
* Digits + Lower case letters
lcCharList = lcDigits + LOWER(lcLetters)
CASE tcCharSet == "BASE36"
* Digits + Upper case letters
lcCharList = lcDigits + lcLetters
CASE tcCharSet == "BASE52"
* All letters
lcCharList = lcLetters + LOWER(lcLetters)
CASE tcCharSet == "BASE62"
* Digits + All letters
lcCharList = lcDigits + lcLetters + LOWER(lcLetters)
OTHERWISE
* The same as BASE10
lcCharList = lcDigits
ENDCASE
RETURN lcCharList


Examples:

* Rollover to min value (Base10)
? NextKey("999999") && 000000

* Next value (Base16)
? NextKey("999999", "Base16") && 99999A

* Dash ('-') has not been changed
? NextKey("999-FFF", "Base16") && 99A-000

Convert Color to HTML

lnRGBColor = RGB(64,128,255)
loColor = Color2Html(lnRGBColor)
? lnRGBColor, loColor.cHTMLcolor
? loColor.nR, loColor.nG, loColor.nB
RETURN
* Converts color number to HTML color format
FUNCTION Color2Html
LPARAMETERS tnColor
LOCAL loColor
loColor = CREATEOBJECT("Empty")
ADDPROPERTY(loColor, "nR", BITAND(tnColor, 0xFF))
ADDPROPERTY(loColor, "nG", BITAND(BITRSHIFT(tnColor, 8), 0xFF))
ADDPROPERTY(loColor, "nB", BITAND(BITRSHIFT(tnColor, 16), 0xFF))
ADDPROPERTY(loColor, "cHTMLcolor", STRTRAN("#" + ;
TRANSFORM(loColor.nR, "@0") + ;
TRANSFORM(loColor.nG, "@0") + ;
TRANSFORM(loColor.nB, "@0"), "0x000000", "" ))
RETURN loColor

Convert Color to RGB

lnRGBColor = RGB(64,128,255)
loColor = Color2RGB(lnRGBColor)
? lnRGBColor, loColor.cRGB
? loColor.nR, loColor.nG, loColor.nB
RETURN
* Converts color number into RGB components and RGB() string
FUNCTION Color2RGB
LPARAMETERS tnColor
* nColor = nR + nG*256 + nB*256*256

LOCAL loColor
loColor = CREATEOBJECT("Empty")
ADDPROPERTY(loColor, "nR", BITAND(tnColor, 0xFF))
ADDPROPERTY(loColor, "nG", BITAND(BITRSHIFT(tnColor, 8), 0xFF))
ADDPROPERTY(loColor, "nB", BITAND(BITRSHIFT(tnColor, 16), 0xFF))
ADDPROPERTY(loColor, "cRGB", "RGB(" + ;
TRANSFORM(loColor.nR) + "," + ;
TRANSFORM(loColor.nG) + "," + ;
TRANSFORM(loColor.nB) + ")")
RETURN loColor

Convert Excel serial number date to VFP date

* Example
? ExcelSerialNumber2Date(39278) && 2007-07-15
? ExcelSerialNumber2Datetime(39278.456777) && 2007-07-15 10:57:46
? ExcelSerialNumber2Time(.456777) && 10:57:46
RETURN
*--------------------------------------------------------------------

* Convert Excel serial number to a date
FUNCTION ExcelSerialNumber2Date(tnExcelSerialNumber)
RETURN {^1899/12/30} + tnExcelSerialNumber

* Convert Excel serial number to a datetime
FUNCTION ExcelSerialNumber2Datetime(tnExcelSerialNumber)
RETURN DTOT({^1899/12/30} + INT(tnExcelSerialNumber)) + ;
ROUND(24*60*60 * (tnExcelSerialNumber % 1),0)

* Convert Excel serial number to a time string
FUNCTION ExcelSerialNumber2Time(tnExcelSerialNumber)
RETURN SUBSTR(TTOC({^2000/01/10 00:00:00} + ROUND(24*60*60 * (tnExcelSerialNumber % 1),0),3), 12)

Editable checkbox in a Grid with AllowCellSelection disabled

PUBLIC oform1

oform1=NEWOBJECT("form1")
oform1.Show
RETURN

DEFINE CLASS form1 AS form
Top = 0
Left = 0
Height = 276
Width = 504
DoCreate = .T.
Caption = "Form1"
ngridx = 0
ngridy = 0
Name = "Form1"

ADD OBJECT grid1 AS grid WITH ;
ColumnCount = 3, ;
HeaderHeight = 39, ;
Height = 216, ;
Left = 12, ;
Panel = 1, ;
Top = 24, ;
Width = 456, ;
AllowCellSelection = .F., ;
Name = "Grid1", ;
Column1.Width = 134, ;
Column1.Name = "Column1", ;
Column2.Width = 111, ;
Column2.Name = "Column2", ;
Column3.Width = 62, ;
Column3.Sparse = .F., ;
Column3.Name = "Column3"

PROCEDURE grid1.Init
WITH This.Column3
.Header1.Caption = "Checkbox"
.AddObject("Check1","CheckBox")
.Sparse = .F.
.CurrentControl = "Check1"
WITH .Check1
.Alignment = 2
.Caption = ""
.Name = "Check1"
.Visible = .T.
ENDWITH
.RemoveObject("text1")
ENDWITH

ENDPROC

PROCEDURE Load
CREATE CURSOR Test ( t1 C(10), t2 C(10), l1 L)
INSERT INTO Test VALUES ( "Test 1 ", "Str 1", .F.)
INSERT INTO Test VALUES ( "Test 2 ", "Str 2", .T.)
INSERT INTO Test VALUES ( "Test 3 ", "Str 3", .F.)
INSERT INTO Test VALUES ( "Test 4 ", "Str 4", .T.)
GO TOP
ENDPROC

PROCEDURE grid1.Click
LOCAL lnRelCol, lnRelRow, lnWhere
STORE 0 TO lnWhere, lnRelRow, lnRelCol
This.GridHitTest(Thisform.nGridX, Thisform.nGridY, @lnWhere, @lnRelRow, @lnRelCol)
IF lnWhere = 3 && Cell
IF lnRelCol = 3 && column 3
This.Columns(lnRelCol).check1.Value = NOT This.Columns(lnRelCol).check1.Value
ENDIF
ENDIF
ENDPROC

PROCEDURE grid1.MouseDown
LPARAMETERS nButton, nShift, nXCoord, nYCoord
* Save mouse position to use in Grid.Click
Thisform.nGridX = nXCoord
Thisform.nGridY = nYCoord
ENDPROC

ENDDEFINE

Excel - Convert Column Number to Column Reference

#DEFINE xlA1 1
#DEFINE xlR1C1 -4150

lnCol = 123
* Using Excel
* oSheet - active sheet in a workbook
lcColRef = oSheet.Cells(1,lnCol).Address(.T.,.F.,xlA1)
*lcColLetter = LEFT(lcColRef, AT("$", lcColRef)-1)
lcColLetter = STREXTRACT(lcColRef, "", "$")

* VFP code only
lcColLetter = IIF(lnCol>26, CHR(Int((lnCol - 1) / 26) + 64), "") + CHR(((lnCol - 1) % 26) + 65)

Excel - Finding the Last Row, Column or Cell

#DEFINE xlA1 1
#DEFINE xlR1C1 -4150
#DEFINE xlLastCell 11

* Last Row/Column
lnLastRow = oSheet.UsedRange.Rows.Count
lnLastCol = oSheet.UsedRange.Columns.Count

* Last Cell - Intersection of the last row and the last column
lcLastCell = oSheet.Cells.SpecialCells(xlLastCell).Address(,,xlR1C1)

(VFP) Fit to Page in Excel and Word

Excel
WITH oSheet.PageSetup
* Fit to Page
.Zoom = .F.
.FitToPagesWide = 1
.FitToPagesTall = 1
ENDWITH

*------------------------------------

* Word
oWord.ActiveDocument.FitToPages()

(VFP) Returning UNC Path associated with a local device

* Windows API
FUNCTION LocalDevice2UNC(tcLocalName)
LOCAL lcUNCBuffer, lnLength, lcLocalName, lcRemoteName
DECLARE INTEGER WNetGetConnection IN WIN32API ;
STRING lpLocalName, STRING @ lpRemoteName, INTEGER @ lplnLength
IF TYPE('tcLocalName') <> "C" OR EMPTY(tcLocalName)
ERROR 11
ENDIF
lcLocalName = ALLTRIM(tcLocalName)
lcUNCBuffer = REPL(CHR(0), 1024)
lnLength = LEN(lcUNCBuffer)
IF WNetGetConnection(lcLocalName, @lcUNCBuffer, @lnLength) = 0
lcRemoteName = LEFT(lcUNCBuffer,AT(CHR(0),lcUNCBuffer)-1)
ELSE
lcRemoteName = ""
ENDIF
RETURN lcRemoteName

*-----------------------------------------------------------------------
* WSH
FUNCTION LocalDevice2UNC(tcLocalName)
LOCAL lcLocalName, lcRemoteName, loFso, loDrive
IF TYPE('tcLocalName') <> "C" OR EMPTY(tcLocalName)
ERROR 11
ENDIF
loFso = CREATEOBJECT("Scripting.FileSystemObject")
lcLocalName = ALLTRIM(tcLocalName)
IF loFso.DriveExists(lcLocalName)
loDrive = loFso.GetDrive(lcLocalName)
lcRemoteName = loDrive.ShareName
ELSE
lcRemoteName = ""
ENDIF
RETURN lcRemoteName

*--------------------------------
* Example
? LocalDevice2UNC("F:")

(VFP) - String comparison in VFP

FoxPro has two distinct parts. The SQL Data Engine that handles SQL command: SELECT, INSERT, UPDATE and DELETE and the rest that handles procedural code. There are differences in string comparison between them. The SET ANSI command controls comparison in the SQL Data Engine and the SET EXACT does the same in the procedural code.

SET ANSI OFF - SQL Data Engine (default setting)
The strings are compared to the length of the shortest string. As result, the comparison will return true if one of the strings is zero-length string regardless of the other string content.

SET EXACT OFF - default setting
The strings are compared to the length of the string on the right of equal sign. As result, the comparison will return true if string on the right is zero-length string regardless of the other string content.

SET ANSI ON - SQL Data Engine
The shorter string is padded to the length of the longer one before comparison and then compared character for character to their entire lengths.

SET EXACT ON
The shorter string is padded to the length of the longer one before comparison and then compared character for character to their entire lengths.

== Operator
The SET EXACT and SET ANSI have no affect on == operator. In the SQL Data Engine it produces the same result as SET ANSI ON but could be slower. In the procedural code strings must contain exactly the same characters, including blanks, to be considered equal.

The sample code demonstrates some of the points discussed.

CLEAR

CREATE TABLE TestTable (text1 C(10), text2 C(5))
INSERT INTO TestTable VALUES ("One", "One")
INSERT INTO TestTable VALUES ("Two", "Two")
INSERT INTO TestTable VALUES ("Three", "Three")
* Zero-length string
lc0LenStr = ""

SET EXACT OFF
? "SET EXACT is "+ SET("EXACT")
? "Comparison is to the length of the right side string"
? "One " = "On" && .T.
? "One" = "On " && .F.
? "One " = "One" && .T.
? "One" = "One " && .F.
? "One" = lc0LenStr && .T.
? lc0LenStr = "One" && .F.
?

SET ANSI OFF
? "SET ANSI is "+ SET("ANSI")
? "Comparison is to the length of the shortest string"
SELECT * FROM TestTable WHERE text2 = "On" INTO CURSOR crsResulr
? _TALLY && 1 record matches
SELECT * FROM TestTable WHERE "On" = text2 INTO CURSOR crsResulr
? _TALLY && 1 record matches
SELECT * FROM TestTable WHERE text2 = "One" INTO CURSOR crsResulr
? _TALLY && 1 record matches
SELECT * FROM TestTable WHERE "One" = text2 INTO CURSOR crsResulr
? _TALLY && 1 record matches
SELECT * FROM TestTable WHERE text2 = lc0LenStr INTO CURSOR crsResulr
? _TALLY && all 3 record matches
SELECT * FROM TestTable WHERE lc0LenStr = text2 INTO CURSOR crsResulr
? _TALLY && all 3 record matches
?

SET EXACT ON
? "SET EXACT is "+ SET("EXACT")
? "The shorter string is padded with spaces before comparison"
? "One " = "On" && .F.
? "On" = "One " && .F.
? "One " = "One" && .T.
? "One" = "One " && .T.
? "One" = lc0LenStr && .F.
? lc0LenStr = "One" && .F.
?

SET ANSI ON
? "SET ANSI is "+ SET("ANSI")
? "The shorter string is padded with spaces before comparison"
SELECT * FROM TestTable WHERE text2 = "On" INTO CURSOR crsResulr
? _TALLY && 0 record matches
SELECT * FROM TestTable WHERE "On" = text2 INTO CURSOR crsResulr
? _TALLY && 0 record matches
SELECT * FROM TestTable WHERE text2 = "One" INTO CURSOR crsResulr
? _TALLY && 1 record matches
SELECT * FROM TestTable WHERE "One" = text2 INTO CURSOR crsResulr
? _TALLY && 1 record matches
SELECT * FROM TestTable WHERE text2 = lc0LenStr INTO CURSOR crsResulr
? _TALLY && 0 record matches
SELECT * FROM TestTable WHERE lc0LenStr = text2 INTO CURSOR crsResulr
? _TALLY && 0 record matches
?

? "== Operator. The string are compared character by character"
? "One " == "On" && .F.
? "On" == "One " && .F.
? "One " == "One" && .F.
? "One" == "One " && .F.
? "One" == lc0LenStr && .F.
? lc0LenStr == "One" && .F.
? "One" == "One" && .T.
?

? "== Operator. The shorter string is padded with spaces before comparison"
SELECT * FROM TestTable WHERE text2 == "On" INTO CURSOR crsResulr
? _TALLY && 0 record matches
SELECT * FROM TestTable WHERE "On" == text2 INTO CURSOR crsResulr
? _TALLY && 0 record matches
SELECT * FROM TestTable WHERE text2 == "One" INTO CURSOR crsResulr
? _TALLY && 1 record matches
SELECT * FROM TestTable WHERE "One" == text2 INTO CURSOR crsResulr
? _TALLY && 1 record matches
SELECT * FROM TestTable WHERE text2 == lc0LenStr INTO CURSOR crsResulr
? _TALLY && 0 record matches
SELECT * FROM TestTable WHERE lc0LenStr == text2 INTO CURSOR crsResulr
? _TALLY && 0 record matches

(VFP) Windows API support class

DEFINE CLASS WinApiSupport AS Custom

* Converts VFP number to the Long integer
FUNCTION Num2Long(tnNum)
LOCAL lcStringl
lcString = SPACE(4)
=RtlPL2PS(@lcString, BITOR(tnNum,0), 4)
RETURN lcString
ENDFUNC

* Convert Long integer into VFP numeric variable
FUNCTION Long2Num(tcLong)
LOCAL lnNum
lnNum = 0
= RtlS2PL(@lnNum, tcLong, 4)
RETURN lnNum
ENDFUNC

* Return Number from a pointer to DWORD
FUNCTION Long2NumFromBuffer(tnPointer)
LOCAL lnNum
lnNum = 0
= RtlP2PL(@lnNum, tnPointer, 4)
RETURN lnNum
ENDFUNC

* Convert Short integer into VFP numeric variable
FUNCTION Short2Num(tcLong)
LOCAL lnNum
lnNum = 0
= RtlS2PL(@lnNum, tcLong, 2)
RETURN lnNum
ENDFUNC

* Retrieve zero-terminated string from a buffer into VFP variable
FUNCTION StrZFromBuffer(tnPointer)
LOCAL lcStr, lnStrPointer
lcStr = SPACE(4096)
lnStrPointer = 0
= RtlP2PL(@lnStrPointer, tnPointer, 4)
lstrcpy(@lcStr, lnStrPointer)
RETURN LEFT(lcStr, AT(CHR(0),lcStr)-1)
ENDFUNC

* Return a string from a pointer to LPWString (Unicode string)
FUNCTION StrZFromBufferW(tnPointer)
Local lcResult, lnStrPointer, lnSen
lnStrPointer = This.Long2NumFromBuffer(tnPointer)

lnSen = lstrlenW(lnStrPointer) * 2
lcResult = Replicate(chr(0), lnSen)
= RtlP2PS(@lcResult, lnStrPointer, lnSen)
lcResult = StrConv(StrConv(lcResult, 6), 2)

RETURN lcResult
ENDFUNC

* Retrieve zero-terminated string
FUNCTION StrZCopy(tnPointer)
LOCAL lcStr, lnStrPointer
lcStr = SPACE(4096)
lstrcpy(@lcStr, tnPointer)
RETURN LEFT(lcStr, AT(CHR(0),lcStr)-1)
ENDFUNC

ENDDEFINE
*------------------------------------------------------------------------
FUNCTION RtlPL2PS(tcDest, tnSrc, tnLen)
DECLARE RtlMoveMemory IN WIN32API AS RtlPL2PS STRING @Dest, Long @Source, Long Length
RETURN RtlPL2PS(@tcDest, tnSrc, tnLen)

FUNCTION RtlS2PL(tnDest, tcSrc, tnLen)
DECLARE RtlMoveMemory IN WIN32API AS RtlS2PL Long @Dest, String Source, Long Length
RETURN RtlS2PL(@tnDest, @tcSrc, tnLen)

FUNCTION RtlP2PL(tnDest, tnSrc, tnLen)
DECLARE RtlMoveMemory IN WIN32API AS RtlP2PL Long @Dest, Long Source, Long Length
RETURN RtlP2PL(@tnDest, tnSrc, tnLen)

FUNCTION RtlP2PS(tcDest, tnSrc, tnLen)
DECLARE RtlMoveMemory IN WIN32API AS RtlP2PS STRING @Dest, Long Source, Long Length
RETURN RtlP2PS(@tcDest, tnSrc, tnLen)

FUNCTION lstrcpy (tcDest, tnSrc)
DECLARE lstrcpy IN WIN32API STRING @lpstring1, INTEGER lpstring2
RETURN lstrcpy (@tcDest, tnSrc)

FUNCTION lstrlenW(tnSrc)
DECLARE Long lstrlenW IN WIN32API Long src
RETURN lstrlenW(tnSrc)

(VFP) Windows Service Status

* Using Shell Application object
* Service name to check
lcServiceName = "MSSQLSERVER"
oShellApp = CreateObject("Shell.Application")
IF NOT oShellApp.IsServiceRunning(lcServiceName)
? "Service isn't running"
* Try to start
IF oShellApp.ServiceStart(lcServiceName,.F.)
? "Service startrted"
ELSE
? "Couldn't start service"
ENDIF
ELSE
? "Service is running"
* Try to stop
IF oShellApp.ServiceStop(lcServiceName, .F.)
? "Service stoped"
ELSE
? "Couldn't stop service"
ENDIF
ENDIF
* Using WIN API
* Service name to check
lcServiceName = "MSSQLSERVER"

* Service Control Manager object specific access types
#define SC_MANAGER_CONNECT 0x0001
#define SC_MANAGER_CREATE_SERVICE 0x0002
#define SC_MANAGER_ENUMERATE_SERVICE 0x0004
#define SC_MANAGER_LOCK 0x0008
#define SC_MANAGER_QUERY_LOCK_STATUS 0x0010
#define SC_MANAGER_MODIFY_BOOT_CONFIG 0x0020

* Service object specific access type
#define SERVICE_QUERY_CONFIG 0x0001
#define SERVICE_CHANGE_CONFIG 0x0002
#define SERVICE_QUERY_STATUS 0x0004
#define SERVICE_ENUMERATE_DEPENDENTS 0x0008
#define SERVICE_START 0x0010
#define SERVICE_STOP 0x0020
#define SERVICE_PAUSE_CONTINUE 0x0040
#define SERVICE_INTERROGATE 0x0080
#define SERVICE_USER_DEFINED_CONTROL 0x0100

* Service State
#define SERVICE_STOPPED 0x00000001
#define SERVICE_START_PENDING 0x00000002
#define SERVICE_STOP_PENDING 0x00000003
#define SERVICE_RUNNING 0x00000004
#define SERVICE_CONTINUE_PENDING 0x00000005
#define SERVICE_PAUSE_PENDING 0x00000006
#define SERVICE_PAUSED 0x00000007

DECLARE Long OpenSCManager IN Advapi32 ;
STRING lpMachineName, STRING lpDatabaseName, Long dwDesiredAccess
DECLARE Long OpenService IN Advapi32 ;
Long hSCManager, String lpServiceName, Long dwDesiredAccess
DECLARE Long QueryServiceStatus IN Advapi32 ;
Long hService, String @ lpServiceStatus
DECLARE Long CloseServiceHandle IN Advapi32 ;
Long hSCObject

lhSCManager = OpenSCManager(0, 0, SC_MANAGER_CONNECT + SC_MANAGER_ENUMERATE_SERVICE)
IF lhSCManager = 0
* Error
ENDIF

lhSChandle = OpenService(lhSCManager, lcServiceName, SERVICE_QUERY_STATUS)
IF lhSCManager = 0
* Error
ENDIF
lcQueryBuffer = REPLICATE(CHR(0), 4*7 )
lnRetVal = QueryServiceStatus(lhSChandle, @lcQueryBuffer )
IF lnRetVal = 0
* Error
ENDIF
* Close Handles
CloseServiceHandle(lhSChandle)
CloseServiceHandle(lhSCManager)
lnServiceStatus = ASC(SUBSTR(lcQueryBuffer,5,1))
IF lnServiceStatus <> SERVICE_RUNNING
* Service isn't running
? "Service isn't running"
ENDIF

Enumerating Windows Services:

loLocator = CREATEOBJECT('WBEMScripting.SWBEMLocator')
loWMI = loLocator.ConnectServer()
loWMI.Security_.ImpersonationLevel = 3 && Impersonate

loWinServices = loWMI.ExecQuery("Select * from Win32_Service ")

FOR EACH loWinService IN loWinServices
WITH loWinService
? .Name, .Displayname, .StartMode, .State, .Status
ENDWITH
ENDFOR

(VFP) How to check if variable is Integer

FoxPro doesn't provide a direct way to check if variable is integer or how many digits it has after decimal point but it can be accomplished using PADL() function.

lnValue = 1.000
* Is Variable integer?
? NOT ( SET("Point") $ PADL(lnValue,20) )

&& Is whole number?
? (lnValue % 1) = 0

* How many digits after decimal point?
? -AT(SET("Point"), PADL(m.lnNumber,20)) % 20

(VFP) Fix VFP file associations to open files in one VFP instance

Windows Registry Editor Version 5.00

[HKEY_CLASSES_ROOT\Visual.FoxPro.Table\shell\open\command]
@="\"C:\\Program Files\\Microsoft Visual FoxPro 9\\vfp9.exe\""

[HKEY_CLASSES_ROOT\Visual.FoxPro.Table\shell\open\ddeexec]
@="open(\"%1\")"
[HKEY_CLASSES_ROOT\Visual.FoxPro.Table\shell\open\ddeexec\Application]
@="FoxPro"
[HKEY_CLASSES_ROOT\Visual.FoxPro.Table\shell\open\ddeexec\Topic]
@="System"

[HKEY_CLASSES_ROOT\Visual.FoxPro.ClassLibrary\shell\open\ddeexec]
@="open(\"%1\")"
[HKEY_CLASSES_ROOT\Visual.FoxPro.ClassLibrary\shell\open\ddeexec\Application]
@="FoxPro"
[HKEY_CLASSES_ROOT\Visual.FoxPro.ClassLibrary\shell\open\ddeexec\Topic]
@="System"

[HKEY_CLASSES_ROOT\Visual.FoxPro.Database\shell\open\ddeexec]
@="open(\"%1\")"
[HKEY_CLASSES_ROOT\Visual.FoxPro.Database\shell\open\ddeexec\Application]
@="FoxPro"
[HKEY_CLASSES_ROOT\Visual.FoxPro.Database\shell\open\ddeexec\Topic]
@="System"

[HKEY_CLASSES_ROOT\Visual.FoxPro.Form\shell\open\ddeexec]
@="open(\"%1\")"
[HKEY_CLASSES_ROOT\Visual.FoxPro.Form\shell\open\ddeexec\Application]
@="FoxPro"
[HKEY_CLASSES_ROOT\Visual.FoxPro.Form\shell\open\ddeexec\Topic]
@="System"

[HKEY_CLASSES_ROOT\Visual.FoxPro.Label\shell\open\ddeexec]
@="open(\"%1\")"
[HKEY_CLASSES_ROOT\Visual.FoxPro.Label\shell\open\ddeexec\Application]
@="FoxPro"
[HKEY_CLASSES_ROOT\Visual.FoxPro.Label\shell\open\ddeexec\Topic]
@="System"

[HKEY_CLASSES_ROOT\Visual.FoxPro.Menu\shell\open\ddeexec]
@="open(\"%1\")"
[HKEY_CLASSES_ROOT\Visual.FoxPro.Menu\shell\open\ddeexec\Application]
@="FoxPro"
[HKEY_CLASSES_ROOT\Visual.FoxPro.Menu\shell\open\ddeexec\Topic]
@="System"

[HKEY_CLASSES_ROOT\Visual.FoxPro.Program\shell\open\ddeexec]
@="open(\"%1\")"
[HKEY_CLASSES_ROOT\Visual.FoxPro.Program\shell\open\ddeexec\Application]
@="FoxPro"
[HKEY_CLASSES_ROOT\Visual.FoxPro.Program\shell\open\ddeexec\Topic]
@="System"

[HKEY_CLASSES_ROOT\Visual.FoxPro.Project\shell\open\ddeexec]
@="open(\"%1\")"
[HKEY_CLASSES_ROOT\Visual.FoxPro.Project\shell\open\ddeexec\Application]
@="FoxPro"
[HKEY_CLASSES_ROOT\Visual.FoxPro.Project\shell\open\ddeexec\Topic]
@="System"

[HKEY_CLASSES_ROOT\Visual.FoxPro.Query\shell\open\ddeexec]
@="open(\"%1\")"
[HKEY_CLASSES_ROOT\Visual.FoxPro.Query\shell\open\ddeexec\Application]
@="FoxPro"
[HKEY_CLASSES_ROOT\Visual.FoxPro.Query\shell\open\ddeexec\Topic]
@="System"

[HKEY_CLASSES_ROOT\Visual.FoxPro.Report\shell\open\ddeexec]
@="open(\"%1\")"
[HKEY_CLASSES_ROOT\Visual.FoxPro.Report\shell\open\ddeexec\Application]
@="FoxPro"
[HKEY_CLASSES_ROOT\Visual.FoxPro.Report\shell\open\ddeexec\Topic]
@="System"

VFP 9.0 Versions

Release Date Version Runtime timestamps (EDT) Description Download Notes
RTM 2004/12/22 9.0.0.2412 2004/12/13 16:20-17:10 Release to manufacturing
SP1 2005/12/08 9.0.0.3504 2005/11/04 17:44-18:15 SP1
SP2 2007/10/12 9.0.0.5721 Original release with botched splash screen
SP2 2007/10/16 9.0.0.5815 2007/10/15 10:15-10:47 Re-release with fixed splash screen SP2
Hotfix 1 2008/04/12 9.0.0.6303 2008/04/11 15:02 KB 948528 Hotfix 948528
Hotfix 2 2008/06/03 9.0.0.6602 2008/06/03 12:12-12:13 KB 952548 Hotfix 952548 Cumulative
Hotfix 3 2009/04/02 9.0.0.7423 2009/02/23 17:58-17:59 KB 968409 Original release with VFP9T.DLL missing
Hotfix 3 2009/04/06 9.0.0.7423 2009/04/03 12:01-14:45 KB 968409 Re-release with VFP9T.DLL included Hotfix 968409 Cumulative

Note 1 Hotfixes KB 952548 and KB 968409 are cumulative.

Keyboard Input Virtual-Key Codes

Virtual-Key Codes constants for Windows API Keyboard Input functions.

* Virtual Keys, Standard Set
#DEFINE VK_LBUTTON 0x01
#DEFINE VK_RBUTTON 0x02
#DEFINE VK_CANCEL 0x03
#DEFINE VK_MBUTTON 0x04 && NOT contiguous with L & RBUTTON

#DEFINE VK_XBUTTON1 0x05 && NOT contiguous with L & RBUTTON
#DEFINE VK_XBUTTON2 0x06 && NOT contiguous with L & RBUTTON

* 0x07 : unassigned

#DEFINE VK_BACK 0x08
#DEFINE VK_TAB 0x09

* 0x0A - 0x0B : reserved

#DEFINE VK_CLEAR 0x0C
#DEFINE VK_RETURN 0x0D

#DEFINE VK_SHIFT 0x10
#DEFINE VK_CONTROL 0x11
#DEFINE VK_MENU 0x12
#DEFINE VK_PAUSE 0x13
#DEFINE VK_CAPITAL 0x14

#DEFINE VK_KANA 0x15
#DEFINE VK_HANGUL 0x15
#DEFINE VK_JUNJA 0x17
#DEFINE VK_FINAL 0x18
#DEFINE VK_HANJA 0x19
#DEFINE VK_KANJI 0x19

#DEFINE VK_ESCAPE 0x1B

#DEFINE VK_CONVERT 0x1C
#DEFINE VK_NONCONVERT 0x1D
#DEFINE VK_ACCEPT 0x1E
#DEFINE VK_MODECHANGE 0x1F

#DEFINE VK_SPACE 0x20
#DEFINE VK_PRIOR 0x21
#DEFINE VK_NEXT 0x22
#DEFINE VK_END 0x23
#DEFINE VK_HOME 0x24
#DEFINE VK_LEFT 0x25
#DEFINE VK_UP 0x26
#DEFINE VK_RIGHT 0x27
#DEFINE VK_DOWN 0x28
#DEFINE VK_SELECT 0x29
#DEFINE VK_PRINT 0x2A
#DEFINE VK_EXECUTE 0x2B
#DEFINE VK_SNAPSHOT 0x2C
#DEFINE VK_INSERT 0x2D
#DEFINE VK_DELETE 0x2E
#DEFINE VK_HELP 0x2F

* VK_0 - VK_9 are the same as ASCII '0' - '9' (0x30 - 0x39)
* 0x40 : unassigned
* VK_A - VK_Z are the same as ASCII 'A' - 'Z' (0x41 - 0x5A)

#DEFINE VK_LWIN 0x5B
#DEFINE VK_RWIN 0x5C
#DEFINE VK_APPS 0x5D

* 0x5E : reserved

#DEFINE VK_SLEEP 0x5F

#DEFINE VK_NUMPAD0 0x60
#DEFINE VK_NUMPAD1 0x61
#DEFINE VK_NUMPAD2 0x62
#DEFINE VK_NUMPAD3 0x63
#DEFINE VK_NUMPAD4 0x64
#DEFINE VK_NUMPAD5 0x65
#DEFINE VK_NUMPAD6 0x66
#DEFINE VK_NUMPAD7 0x67
#DEFINE VK_NUMPAD8 0x68
#DEFINE VK_NUMPAD9 0x69
#DEFINE VK_MULTIPLY 0x6A
#DEFINE VK_ADD 0x6B
#DEFINE VK_SEPARATOR 0x6C
#DEFINE VK_SUBTRACT 0x6D
#DEFINE VK_DECIMAL 0x6E
#DEFINE VK_DIVIDE 0x6F
#DEFINE VK_F1 0x70
#DEFINE VK_F2 0x71
#DEFINE VK_F3 0x72
#DEFINE VK_F4 0x73
#DEFINE VK_F5 0x74
#DEFINE VK_F6 0x75
#DEFINE VK_F7 0x76
#DEFINE VK_F8 0x77
#DEFINE VK_F9 0x78
#DEFINE VK_F10 0x79
#DEFINE VK_F11 0x7A
#DEFINE VK_F12 0x7B
#DEFINE VK_F13 0x7C
#DEFINE VK_F14 0x7D
#DEFINE VK_F15 0x7E
#DEFINE VK_F16 0x7F
#DEFINE VK_F17 0x80
#DEFINE VK_F18 0x81
#DEFINE VK_F19 0x82
#DEFINE VK_F20 0x83
#DEFINE VK_F21 0x84
#DEFINE VK_F22 0x85
#DEFINE VK_F23 0x86
#DEFINE VK_F24 0x87

* 0x88 - 0x8F : unassigned

#DEFINE VK_NUMLOCK 0x90
#DEFINE VK_SCROLL 0x91
*
#DEFINE VK_LSHIFT 0xA0
#DEFINE VK_RSHIFT 0xA1

(VFP) Retrieving VFP runtime DLL name required by EXE or DLL

VFP stores in EXE/DLL information about what runtime DLL is required to run it.

? VfpVersionFromExeOrDll("C:\Program Files\My Company\MyVfpApplication.exe")
? VfpVersionFromExeOrDll("X:\Somefolder\MyVfpDll.dll")

* VfpVersionFromExeOrDll.PRG
FUNCTION VfpVersionFromExeOrDll
LPARAMETERS tcExeDllName
LOCAL lcSig, lnHandle, lcVersion, lcBuffer, lnPos, lcSigMT
lnHandle = FOPEN(tcExeDllName, 0)
IF lnHandle < 0
? FERROR()
RETURN "Unable to Open file + '" + tcExeDllName + "'"
ENDIF
lcSig = "VisualFoxProRuntime."
lcSigMT = "VisualFoxProRuntimeMT."
lcVersion = "(Unknown)"
* Read first 64KB
lcBuffer = FREAD(lnHandle, 65535)
* Check for regular runtime signature
lnPos = AT(lcSig, lcBuffer)
IF lnPos > 0
*lcVersion = "Vfp " + STRTRAN(SUBSTR(lcBuffer, lnPos + LEN(lcSig),2), CHR(0), "") + ".0"
lcVersion = "Vfp" + STRTRAN(SUBSTR(lcBuffer, lnPos + LEN(lcSig),2), CHR(0), "") + "R.dll"
ELSE
* Check for Multithreaded (MT) runtime signature
lnPos = AT(lcSigMT, lcBuffer)
IF lnPos > 0
*lcVersion = "Vfp MT " + STRTRAN(SUBSTR(lcBuffer, lnPos + LEN(lcSigMT),2), CHR(0), "") + ".0"
lcVersion = "Vfp" + STRTRAN(SUBSTR(lcBuffer, lnPos + LEN(lcSigMT),2), CHR(0), "") + "T.dll"
ENDIF
ENDIF
=FCLOSE(lnHandle)
RETURN lcVersion

(VFP) Class Not Licensed For Use

This is because some of the MS Active X controls need a developer license, otherwise the CREATEOBJECT() doesn't work. An easy workaround is to add the Active X to a form or form class and make calls to the Active X controls on this form. The license information is stored in the Registry in this key: HKEY_CLASSES_ROOT\Licenses. It'll probably work fine if you add the license info to your customer's registry. It just takes a little while to identify the correct license code for your the Active X control. Also, it is important to take note of the default value in the HKEY_CLASSES_ROOT\Licenses key:

Licensing: Copying the keys may be a violation of established copyrights.

Read more about it in the MSKB.
INFO: OLE Control Licensing in Visual FoxPro

http://support.microsoft.com/default.aspx?scid=KB;en-us;139154

I ran into a similar problem trying to use MSCOMM32.OCX on a client's machine. I searched for a fix in Microsoft's KB and found Microsoft Knowledge Base Article - 192693. Check it out at http://support.microsoft.com/default.aspx?scid=kb;EN-US;192693. Their suggestion is to subclass the control and instantiate the subclass. Worked for me.

(VFP) Inregistrari DUBLE tabela

SELECT * FROM myTable UNION SELECT * FROM myTable

OR

SELECT account_id FROM customer GROUP BY account_id ;
HAVING COUNT(account_id) > 1

OR

SELECT first_name + last_name AS cust_name ;
FROM customer GROUP BY first_name + last_name ;
HAVING COUNT(first_name + last_name) > 1

OR

SELECT * FROM customer WHERE account_id IN ;
(SELECT account_id FROM customer GROUP BY account_id ;
HAVING COUNT(account_id) > 1)

OR

SELECT * FROM myTable WHERE myField IN ;
(SELECT myField FROM myTable ;
GROUP by myField HAVING COUNT(myField) > 1);
INTO CURSOR myDuplicates

(VFP) - How To Calling Store Procedure From VFP

USING SQL SERVER:
=======================
MYSTS = "EXECUTE MYQUE"
SQLEXEC(1, MYSTS, "MYCURSOR")


USING MYSQL:
=================
MYSTS = "CALL MYQUE();"
SQLEXEC(1, MYSTS, "MYCURSOR")

Configuring SQL Server authentication for MSDE and MS SQL Server

By default, when you install MSDE it is configured to support Windows authentication only. Windows authentication is usually not appropriate for web applications such as Enterprise Server, so you will have to override the default installation settings. Additionally, the setup program for MSDE has a bug, so even if you run the MSDE setup program with the parameter SECURITYMODE=SQL it will ignore this parameter and leave the security mode set to Windows Authentication only. As such, once you have installed MSDE, you will have to manually change the security mode for the MSDE Server by making some changes to the windows registry.
The following is a brief description of this process. For further information, refer to http://support.microsoft.com/kb/Q322336/EN-US/

I. Manually changing the authentication settings for SQL Server 2005 and SQL Server 2005 Express servers

You can change the Authentication mode on existing MSDE Servers by modifying a value in the windows registry, as follows:

1.Run the registry editor (Select Start | Run from the windows start menu, type regedit and then click OK).

2.Locate the key HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Microsoft SQL Server\MSSQL.x\MSSQLServer

(Note If you are using SQL Server 2005, the above registry key is used to store the authentication mode regardless of whether you installed a default instance or a named instance. MSSQL.x is a placeholder for the corresponding value for your system).

3.Set the value LoginMode to 2. This tells your server to accept SQL Server & Windows authentication methods.

4.Make sure to stop and restart the MSSQL service after making this change. You can do this by executing the two following commands from the command prompt

NET STOP MSSQLSERVER
NET START MSSQLSERVER

II. Manually changing the authentication settings for SQL Server 2000 and MSDE 2000 servers

You can change the Authentication mode on existing MSDE Servers by modifying a value in the windows registry, as follows:

1.Run the registry editor (Select Start | Run from the windows start menu, type regedit and then click OK).

2.Set the value HKLM\Software\Microsoft\MSSqlserver\MSSqlServer\LoginMode to 2. This tells your server to accept SQL Server & Windows authentication methods.

(Note: If you used a Named Instance when you installed MSDE, then the key will be HKLM\Software\Microsoft\Microsoft SQL Server\Instance Name\MSSqlserver\LoginMode).

3.Make sure to stop and restart the MSSQL service after making this change. You can do this by executing the two following commands from the command prompt

NET STOP MSSQLSERVER
NET START MSSQLSERVER

How to Change MSDE 'sa' password

Change your MSSQL Server or MSDE password for 'sa' login

C:\osql -U sa

1>sp_password NULL,'new_password','sa'
2>go
3>quit

Fix Generic Host For Win32 and Svchost.exe Error

Now we no longer have to worry about “Generic Host for Win32 Process” and “svchost.exe” errors that haunt our Windows XP almost daily (If not cured). Below i will explain what are the symptoms of this evil problem and how easily it can be fixed:

Symptoms:
You are surfing the internet or are engaged any type of Internet activity when suddenly all your Network activity goes to hault. You can still see the Internet connected icon in the tray but you cannot surf, browse or do anything.
You get an error message something like “Generic Host Process for Win32 Services has encountered a problem and needs to close. We are sorry for the inconvenience.”
Error message reporting about faulting netapi32.dll and svchost.exe.
You try to disconnect your Internet because of no activity observed but the Internet icon wont disappear.
You recieve an error message something like “Your PC has recovered from a serious problem” etc.

Solution:

Follow these simple steps and your Windows will be fully cured of this menace

Close Port 445:

1. Start Registry Editor (Regedit.exe) by clicking Start menu, and then click the Run icon.
2. In the small box that Opens, type: regedit then click the OK button. The Registry Editor will now have opened.
3. Locate the following key in the registry:
HKEY_LOCAL_MACHINE\System\CurrentControlSet\Services\NetBT\Parameters
In the right-hand side of the window find an option called TransportBindName.
Double click that value, and then delete the default value, thus giving it a blank value.

Close Port 135:

1. Then you must now navigate to the following registry key:
HKEY_LOCAL_MACHINE\Software\Microsoft\OLE
2. You will see there is a String Value called: EnableDCOM
Set the value to: N (it should currently be Y)
3. Close the Registry Editor. Shutdown and Restart your computer.

Well thats all but if you want you can disable NETbios.