Create Shortcut with RunAs Administrator using VFP

Create Shortcut with RunAs Administrator using Visual FoxPro Code.

Function CreateShortcut
Lparameters lcExecutableFile,lcShortcutText,lcProgramDesc,llRunAsAdmin

lcTmpShortCutFile  = Addbs(Getenv("TEMP")) + Sys(2015)+".lnk"

oWsh = Createobject("wscript.shell")
cDeskpath = oWsh.SpecialFolders("desktop")

lcShortcutFile = cDeskpath+"\"+lcShortcutText+".lnk"
If llRunAsAdmin
oShort = oWsh.CreateShortcut(lcTmpShortCutFile)
Else
oShort = oWsh.CreateShortcut(lcShortcutFile)
Endif

oShort.TargetPath = lcExecutableFile
oShort.WorkingDirectory = Addbs(Justpath(lcExecutableFile))
oShort.Description = lcProgramDesc
oShort.Save

If llRunAsAdmin && Creating New Shortcut with RunAs option.

nhandle     = Fopen(lcTmpShortCutFile)
nFilesize     = Fseek(nhandle,0,2)
=Fclose(nhandle)
nhandle     = Fopen(lcTmpShortCutFile)

nHandle2     =  Fcreate(lcShortcutFile)
If nhandle     = -1  &&OR nHandle2 = -1
Wait Window [both source and destination files must be accessible]
=Fclose(nhandle)
=Fclose(nHandle2)
Return
Endif

nRemain     = nFilesize
i = 0
Do While !Feof(nhandle)
nChunk     = 1 && MIN(100,nRemain)
cTake     = Fread(nhandle,nChunk)

If i=21
cTake = Chr(32)  && a[0x15] |= 0x20; // flip the bit.  for RunAsAdmin
Endif

=Fwrite(nHandle2,cTake,nChunk)
nRemain = nRemain - nChunk

i = i + 1
If nRemain = 0
Exit
Endif
Enddo
=Fclose(nhandle)
=Fclose(nHandle2)

Delete File "&lcTmpShortCutFile"
Endif
Return

Visual FoxPro Advance ( Visual FoxPro 10) Preview

Visual FoxPro 10 (Visual FoxPro Advance) preview available.

check more detail on below link

http://www.baiyujia.com/vfpadvance/f_vfpa_history.asp

Add & Delete Custom Printer Forms

* AddPrinterForm.prg
DEFINE CLASS AddPrinterForm AS Custom
 
 HIDDEN cUnit, cPrinterName, nFormHeight, nFormWidth, nLeftMargin, ;
              nTopMargin, nRightMargin, nBottomMargin, nInch2mm, nCm2mm, nCoefficient, hHeap
 
 cUnit = "English"  && inches or Metric - cm's
 cPrinterName = ""
 nFormHeight = 0
 nFormWidth = 0
 nLeftMargin = 0
 nTopMargin = 0
 nRightMargin = 0
 nBottomMargin = 0
 
 cApiErrorMessage = ""
 cErrorMessage = ""
 
 nInch2mm = 25.4
 nCm2mm = 10
 nCoefficient = This.nInch2mm * 1000
 
 hHeap = 0
 
 * Win API support class
 oWas = NULL
 
 PROCEDURE Init(tcUnit)
 This.oWas = NEWOBJECT("WinApiSupport", "WinApiSupport.fxp")
 IF PCOUNT() = 1 
  This.cUnit = PROPER(tcUnit)
 ENDIF
 This.LoadApiDlls()
 This.hHeap = HeapCreate(0, 4096, 0)
 * Use Windows default printer
 This.cPrinterName = SET("Printer",2)
 ENDPROC
 
 PROCEDURE cUnit_Assign(tcUnit)
 IF INLIST(tcUnit, "English", "Metric")
  This.cUnit = PROPER(tcUnit)
 ELSE
  RETURN 
 ENDIF
 * Calculate conversion coefficient
 This.nCoefficient = IIF(PROPER(This.cUnit) = "English", ;
      This.nInch2mm, This.nCm2mm) * 1000
 ENDPROC
 
 PROCEDURE Destroy
 IF This.hHeap <> 0
  HeapDestroy(This.hHeap)
 ENDIF
 
 ENDPROC
 
 PROCEDURE SetFormMargins(tnLeft, tnTop, tnRight, tnBottom)
 WITH This
  .nLeftMargin  = tnLeft   * .nCoefficient
  .nTopMargin  = tnTop    * .nCoefficient
  .nRightMargin  = tnRight  * .nCoefficient
  .nBottomMargin  = tnBottom * .nCoefficient
 ENDWITH
 ENDPROC
 
 PROCEDURE AddForm(tcFormName, tnWidth, tnHeight, tcPrinterName)
 LOCAL lhPrinter, llOK, lcForm
 
 This.nFormWidth  = tnWidth  * This.nCoefficient
 This.nFormHeight = tnHeight * This.nCoefficient
 IF PCOUNT() > 3
  This.cPrinterName = tcPrinterName
 ENDIF
 
 This.ClearErrors()
 lhPrinter = 0
 IF OpenPrinter(This.cPrinterName, @lhPrinter, 0) = 0
  This.cErrorMessage = "Unable to get printer handle for " + This.cPrinterName 
  This.cApiErrorMessage = WinApiErrMsg(GetLastError())
  RETURN .F.
 ENDIF
 
 lnFormName = HeapAlloc(This.hHeap, 0, LEN(tcFormName) + 1)
 = SYS(2600, lnFormName, LEN(tcFormName) + 1, tcFormName + CHR(0))
 
 * Build FORM_INFO_1 structure
 WITH This.oWas
  lcForm = .Num2Long(0) + .Num2Long(lnFormName) + ;
   .Num2Long(This.nFormWidth) + .Num2Long(This.nFormHeight) + ;
   .Num2Long(This.nLeftMargin) + .Num2Long(This.nTopMargin) + ;
   .Num2Long(This.nFormWidth - This.nRightMargin) + ;
   .Num2Long(This.nFormHeight - This.nBottomMargin)
 ENDWITH
 
 * Finally, call the API
 IF AddForm(lhPrinter, 1, @lcForm) = 0
  This.cErrorMessage = "Unable to Add Form " + tcFormName 
  This.cApiErrorMessage = STRTRAN(WinApiErrMsg(GetLastError()), "file", "form", -1, -1, 3)
  llOK = .F.
 ELSE
  llOK = .T.
 ENDIF
 = HeapFree(This.hHeap, 0, lnFormName)
 = ClosePrinter(lhPrinter)
 
 RETURN llOK
 
 PROCEDURE ClearErrors
 This.cErrorMessage = ""
 This.cApiErrorMessage = ""
 ENDPROC
 
 PROCEDURE DeleteForm(tcFormName, tcPrinterName)
 LOCAL lhPrinter, llOK
 
 IF PCOUNT() > 1
  This.cPrinterName = tcPrinterName
 ENDIF
 
 This.ClearErrors()
 lhPrinter = 0
 IF OpenPrinter(This.cPrinterName, @lhPrinter, 0) = 0
  This.cErrorMessage = "Unable to get printer handle for " + This.cPrinterName + "."
  This.cApiErrorMessage = WinApiErrMsg(GetLastError())
  RETURN .F.
 ENDIF
 
 * Finally, call the API
 llOK = ( DeleteForm(lhPrinter, tcFormName) <> 0 )
 IF NOT llOK 
  This.cErrorMessage = "Unable to delete Form " + tcFormName 
  This.cApiErrorMessage = STRTRAN(WinApiErrMsg(GetLastError()), "file", "form", -1, -1, 3)
 ENDIF
 = ClosePrinter(lhPrinter)
 RETURN llOK
 
 HIDDEN PROCEDURE LoadApiDlls
  DECLARE Long HeapCreate IN WIN32API Long dwOptions, Long dwInitialSize, Long dwMaxSize
  DECLARE Long HeapAlloc IN WIN32API Long hHeap, Long dwFlags, Long dwBytes
  DECLARE Long HeapFree IN WIN32API Long hHeap, Long dwFlags, Long lpMem
  DECLARE HeapDestroy IN WIN32API Long hHeap
  DECLARE Long GetLastError IN kernel32
 ENDPROC
 
ENDDEFINE
*----------------------------------------------------------------------------------------------
 
FUNCTION OpenPrinter(tcPrinterName, thPrinter, tcDefault)
DECLARE Long OpenPrinter IN WinSpool.Drv ;
 String pPrinterName, Long @ phPrinter, String pDefault
RETURN  OpenPrinter(tcPrinterName, @thPrinter, tcDefault)
 
FUNCTION ClosePrinter (thPrinter)
DECLARE Long ClosePrinter IN WinSpool.Drv Long hPrinter
RETURN ClosePrinter(thPrinter)
 
 
FUNCTION AddForm(thPrinter, tnLevel, tcForm)
DECLARE Long AddForm IN winspool.drv Long hPrinter, Long Level, String @pForm
RETURN AddForm(thPrinter, tnLevel, tcForm)
 
FUNCTION DeleteForm(thPrinter, tcForm)
DECLARE Long DeleteForm IN winspool.drv Long hPrinter, String  pFormName 
RETURN DeleteForm(thPrinter, tcForm)

* Ref : http://www.berezniker.com

Another Free Report Viewer for Visual FoxPro

Export your Visual FoxPro reports to Images, RTF, PDF, HTML or XLS super easy! Send them by email! Enhance the look of your previews, and allow your users to decide how his report previews will be.


http://foxypreviewer.codeplex.com

Find Paper ID Programmatically

****************** Find Paper Size ID from Printer ****************

PROCEDURE FindPaperID
PARAMETERS lc_FindPaperName

#Define DC_PAPERS 2
#Define DC_PAPERS_Size 2
#Define DC_PAPERNAMES 16
#Define DC_PAPERNAMES_Size 64
Declare Long DeviceCapabilities In WinSpool.drv ;
String cPrinterName, String cPort, Short nCapFlags, ;
String @O_cBuffer, Long pDevMode

Local Array la_Printer[1]
Local ln_Row, ln_Result, ln_I, ln_Index
Local lc_PrinterName, lc_Buffer
Local lc_PaperSizeID, lc_PaperName,nPaperID
nPaperId=0

lc_PrinterName = Set( 'Printer', 2 ) && Get default windows printer
= Aprinters( la_Printer )
ln_Row = Ascan( la_Printer, lc_PrinterName, 1, 0, 0, 9 )
ln_Result = DeviceCapabilities( la_Printer[ ln_Row, 1 ], ;
la_Printer[ ln_Row, 2 ], DC_PAPERNAMES, 0, 0 )
If (ln_Result > 0)
ln_Index = -1
* lc_FindPaperName = Upper( 'MyCustom - Half A4' )
lc_Buffer = Replicate( Chr(0), ln_Result * DC_PAPERNAMES_Size )
ln_Result = DeviceCapabilities( la_Printer[ ln_Row, 1 ], ;
la_Printer[ ln_Row, 2 ], DC_PAPERNAMES, @lc_Buffer, 0 )
For ln_I = 0 To ln_Result-1
lc_PaperName = Upper( Substr( lc_Buffer, (ln_I * DC_PAPERNAMES_Size )+1, ;
DC_PAPERNAMES_Size ))
lc_papername = SUBSTR(lc_papername,1,LEN(lc_FindPaperName))

If (UPPER(lc_FindPaperName) $ upper(lc_PaperName))
ln_Index = ln_I
Exit
Endif
NEXT
* ? "Ok"
If (ln_Index != -1)
** Paper Name found
** Get PaperSize ID
ln_Result = DeviceCapabilities( la_Printer[ ln_Row, 1 ], ;
la_Printer[ ln_Row, 2 ], DC_PAPERS, 0, 0 )

If (ln_Result > 0)
lc_Buffer = Replicate( Chr(0), ln_Result * DC_PAPERS_Size )
ln_Result = DeviceCapabilities( la_Printer[ ln_Row, 1 ], ;
la_Printer[ ln_Row, 2 ], DC_PAPERS, @lc_Buffer, 0 )
lc_PaperSizeID = Substr( lc_Buffer, (ln_Index * DC_PAPERS_Size )+1, DC_PAPERS_Size )
* ? 'PaperSize ID for "' + lc_FindPaperName + '" is', CToBin( lc_PaperSizeID, '2rs' )
nPaperId = CToBin( lc_PaperSizeID, '2rs')
ENDIF
ENDIF
ENDIF

RETURN nPaperId

Custom Page Size

PROCEDURE AddPaperId

LPARAMETERS cPaperName,nPaperHeight,nPaperWidth

nPaperHeight = nPaperHeight &&ROUND(nPaperHeight * 10000,0)

nPaperWidth = nPaperWidth &&ROUND(nPaperWidth * 10000,0)

Local hPrinter,lReturn

Local cPrinterName && , cPaperName

Local pPaperName, sPaperSize

Local nResult, nBufLen &&, nPaperWidth, nPaperHeight

Declare Long GetLastError In Kernel32

Declare Long ClosePrinter In WinSpool.Drv Long hPrinter

Declare Long OpenPrinter In WinSpool.Drv ;

String cPrinterName, Long @O_hPrinter, Long pDefault

Declare Long GetForm In WinSpool.drv As GetPrinterForm ;

Long hPrinter, String pFormName, ;

Long nLevelInfo, String @O_pFormInfo, ;

Long nBufSize, Long @O_nBufNeeded

Declare Long AddForm In WinSpool.drv As AddPrinterForm ;

Long hPrinter, Long nLevelInfo, String @pFormInfo

Declare Long LocalAlloc In Kernel32 Long uFlags, Long dwBytes

Declare Long LocalFree In Kernel32 Long Hmem

cPrinterName = Set( 'Printer', 2 ) && Get default Windows printer

hPrinter = 0

lReturn = .f.

If (OpenPrinter( cPrinterName, @hPrinter, 0 ) != 0)

* cPaperName = 'MyCustom-Half A4'

nBufLen = 32 && FORM_INFO_1_Size

cInfo = Replicate( Chr(0), 32 )

nResult = GetPrinterForm( hPrinter, cPaperName, 1, ;

@cInfo, nBufLen, @nBufLen )

If (nResult == 0) && Get printer form failed

nResult = GetLastError()

If (nResult == 1902) && ERROR_INVALID_FORM_NAME

** Custom Printer Form not exist, add the new one

* nPaperWidth = 210000 / 2 && Paper size is in 1/1000 millimeters

* nPaperHeight = 297000 / 2

sPaperSize = BinToC( nPaperWidth, '4rs' ) + BinToC( nPaperHeight, '4rs' )

pPaperName = LocalAlloc( 64, 32 )

If (pPaperName != 0)

Sys( 2600, pPaperName, Len( cPaperName ), cPaperName )

cInfo = BinToC( 0, '4rs' ) + BinToC( pPaperName, '4rs' ) + ;

sPaperSize + BinToC( 0, '4rs' ) + BinToC( 0, '4rs' ) + sPaperSize

If (AddPrinterForm( hPrinter, 1, cInfo ) != 0)

lReturn = .t.

*? 'Custom paper form (' + cPaperName + ') has been added! '

ELSE

lReturn = .f.

*? 'Error:', GetLastError()

Endif

LocalFree( pPaperName )

Endif

Else

If (nResult == 122) && Insufficient buffer

* ? 'Error: Custom Paper Form already exist!'

Else

* ? 'Error: ', nResult

Endif

Endif

Else

* ? 'Error: ', nResult

Endif

ClosePrinter( hPrinter )

ENDIF

RETURN

Customize Report Viewer for VFP and Export in PDF, TIFF

you Can Export your Report in PDF, TIFF

http://www.report-sculptor.com/

Visual FoxPro Useful Links

Freeware Utility Like Compression (Zip), Encryption

http://www.sweetpotatosoftware.com/SPSBlog/default.aspx

Various Samples Download

http://www.universalthread.com