Arama seçenekleri (Sayfa 1 / 34)

* All sizes in inches

ooo = NEWOBJECT("AddPrinterForm", "AddPrinterForm.fxp")

IF NOT ooo.AddForm("MyCustomForm1", 5,7, lcPrinterName)

    ? ooo.cErrorMessage

    ? ooo.cApiErrorMessage 

  * Error

ENDIF

 

*!*    * Delete just created form

*!*    ooo = NEWOBJECT("AddPrinterForm", "AddPrinterForm.fxp")

*!*    IF NOT ooo.DeleteForm("MyCustomForm1", lcPrinterName)

*!*        ? ooo.cErrorMessage

*!*        ? ooo.cApiErrorMessage 

*!*      * Error

*!*    ENDIF

 

 

* All sizes in cm

ooo = NEWOBJECT("AddPrinterForm", "AddPrinterForm.fxp", "", "Metric")

IF NOT ooo.AddForm("MyCustomForm2", 15,17, lcPrinterName)

  * Error

ENDIF

 

*!*    * Delete just created form

*!*    ooo = NEWOBJECT("AddPrinterForm", "AddPrinterForm.fxp")

*!*    IF NOT ooo.DeleteForm("MyCustomForm2", lcPrinterName)

*!*        ? ooo.cErrorMessage

*!*        ? ooo.cApiErrorMessage 

*!*      * Error

*!*    ENDIF

 

* 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)

*!*    Yahoo ÇALIŞIYOR

*******************************

*!* Example of using SendViaBLAT

*******************************

#DEFINE PRIORITYHIGH 1

#DEFINE PRIORITYLOW 0

 

DIMENSION aryAttach(2)

aryAttach(1) = "C:\Test1.txt" && change to an actual file that exists on your computer

aryAttach(2) = "C:\Test2.txt" && change to an actual file that exists on your computer

 

LOCAL lcFrom, lcTo, lcSubject, lcBody, lcCC, lcBCC, lcMailServer, lcUserName, lcPassword, lnPort, lnPriority, llHTMLFormat, lcErrReturn

 

lcFrom = "ugurlu2001#yahoo;com"

lcTo = "ugurlu2001#hotmail;com"

lcSubject = "Deneme konusu!"

*!* Sending the body in HTML format

llHTMLFormat = .T. && change to .F. to send plain text message

lcBody = "<a href='http://www.fox4um.com'>" + ;

 "Deneme icin yollandi!" + ;

 "</a>"

lcCC = "ugurlu2001#gmail;com"

lcBCC = "ugurlu2001#yahoo;com"

lcMailServer = "smtp.mail.yahoo.com" && my SMTP Server

lnPort = 25 && or 587 or 995 default SMTP Server port

lcUserName = "ugurlu2001#yahoo;com" && my SMTP username

lcPassword = "xxxxxxxxxxxx/" && my SMTP password

lnPriority = PRIORITYHIGH

 

SendViaBLAT(@lcErrReturn, lcFrom, lcTo, lcSubject, lcBody, @aryAttach, lcCC, lcBCC, lcMailServer, lnPort, lcUserName, lcPassword, lnPriority, llHTMLFormat)

 

IF EMPTY(lcErrReturn)

 MESSAGEBOX("'" + lcSubject + "' sent successfullly.", 64, "Send email via BLAT")

ELSE

 MESSAGEBOX("'" + lcSubject + "' failed to be sent.  Reason:" + CHR(13) + lcErrReturn, 64, "Send email via BLAT")

ENDIF

 

*******************************************

PROCEDURE SendViaBLAT(tcReturn, tcFrom, tcTo, tcSubject, tcBody, taFiles, tcCC, tcBCC, tcMailServer, tnPort, tcUserName, tcPassword, tnPriority, tlHTMLFormat)

*******************************************

 LOCAL lcBlatParam, lcBodyFile, lnCountAttachments, lnResult, loError as Exception

 

 lcBodyFile = ""

 

 TRY

  *!* Include full path in Declare, such as "C:\Blat240\full\blat.dll"

  *!* or make sure that blat.dll is included in the system's PATH variable

  DECLARE INTEGER Send IN "O:\F_Kullan\Blat\blat262.full\blat262\full\blat.dll" STRING cParam

  

  lcBodyFile = ADDBS(SYS(2023)) + SYS(2015) + ".txt"

  STRTOFILE(tcBody, lcBodyFile, 0) && body is placed in a text file to be sent by BLAT

  

  lcBlatParam = GetShortPath(lcBodyFile)

  

  IF TYPE("tcTo") = "C"

    lcBlatParam = lcBlatParam + " -to " + ALLTRIM(tcTo)

  ENDIF

  IF TYPE("tcFrom") = "C"

    lcBlatParam = lcBlatParam + " -f " + ALLTRIM(tcFrom)

  ENDIF

  IF TYPE("tcCC") = "C"

    lcBlatParam = lcBlatParam + " -cc " + ALLTRIM(tcCC)

  ENDIF

  IF TYPE("tcBCC") = "C"

    lcBlatParam = lcBlatParam + " -bcc " + ALLTRIM(tcBCC)

  ENDIF

  IF TYPE("tcSubject") = "C"

    lcBlatParam = lcBlatParam + [ -s "] + ALLTRIM(tcSubject) + ["]

  ENDIF

  IF TYPE("tcMailserver") = "C"

    lcBlatParam = lcBlatParam + " -server " + ALLTRIM(tcMailserver)

  ENDIF

  IF TYPE("tnPort") = "N"

    lcBlatParam = lcBlatParam + ":" + TRANSFORM(tnPort)

  ENDIF

  IF TYPE("tcUsername") = "C"

    lcBlatParam = lcBlatParam + " -u " + ALLTRIM(tcUsername)

  ENDIF

  IF TYPE("tcPassword") = "C"

    lcBlatParam = lcBlatParam + " -pw " + ALLTRIM(tcPassword)

  ENDIF

  IF TYPE("tnPriority") = "N" AND BETWEEN(tnPriority, 0, 1)

    lcBlatParam = lcBlatParam + " -priority " + TRANSFORM(tnPriority)

  ENDIF

  IF TYPE("tlHTMLFormat") = "L" AND tlHTMLFormat

    lcBlatParam = lcBlatParam + " -html"

  ENDIF

 

  IF TYPE("taFiles", 1) = "A"

    lcBlatParam = lcBlatParam + " -attach "

   FOR lnCountAttachments = 1 TO ALEN(taFiles)

     lcBlatParam = lcBlatParam + GetShortPath(ALLTRIM(taFiles(lnCountAttachments))) + ","

   ENDFOR

   lcBlatParam = LEFT(lcBlatParam, LEN(lcBlatParam) - 1) && Remove Extra Comma

  ENDIF

 

  lnResult = Send(ALLTRIM(lcBlatParam))

  

  IF lnResult != 0

   DO CASE

    CASE lnResult = -2

     THROW "The server actively denied our connection./The mail server doesn't like the sender name. "

    CASE lnResult = -1

     THROW "Unable to open SMTP socket" OR ;

       "SMTP get line did not return 220" OR ;

       "command unable to write to socket" OR ;

       "Server does not like To: address" OR ;

       "Mail server error accepting message data."

    CASE lnResult = 1

     THROW "File name (message text) not given" OR ;

       "Bad argument given"

    CASE lnResult = 2

     THROW "File (message text) does not exist"

    CASE lnResult = 3

     THROW "Error reading the file (message text) or attached file"

    CASE lnResult = 4

     THROW "File (message text) not of type FILE_TYPE_DISK "

    CASE lnResult = 5

     THROW "Error Reading File (message text)"

    CASE lnResult = 12

     THROW "-server or -f options not specified and not found in registry"

    CASE lnResult = 13

     THROW "Error opening temporary file in temp directory"

    OTHERWISE

     THROW "Unknown Error"

   ENDCASE

  ENDIF

 

 CATCH TO loError

  tcReturn = [Error: ] + STR(loError.ERRORNO) + CHR(13) + ;

   [LineNo: ] + STR(loError.LINENO) + CHR(13) + ;

   [Message: ] + loError.MESSAGE + CHR(13) + ;

   [Procedure: ] + loError.PROCEDURE + CHR(13) + ;

   [Details: ] + loError.DETAILS + CHR(13) + ;

   [StackLevel: ] + STR(loError.STACKLEVEL) + CHR(13) + ;

   [LineContents: ] + loError.LINECONTENTS

 FINALLY

  CLEAR DLLS "Send"

  IF FILE(lcBodyFile)

   ERASE (lcBodyFile)

  ENDIF

 ENDTRY

ENDPROC

 

****************************************

Function GetShortPath

****************************************

 LPARAMETERS lcFileName

 LOCAL lnReturn, lcBuffer

 

 Declare Integer GetShortPathNameA In Win32API As GetShortPathName String, String, Integer

 

 lcBuffer = SPACE(255)

 lnReturn= GetShortPathName(lcFileName, @lcBuffer, 255)

 

 Clear Dlls "GetShortPathName"

 

 Return (Left(lcBuffer, lnReturn))

ENDFUNC

This.AddProperty(This,"CursorSavedStatus",.F.)

This.AddProperty(This,"CursorSavedNo",0)