Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

Register Log in
  • Congratulations Mike Lewis on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Whatsapp automation with VFP 3

Status
Not open for further replies.
TariqMehmod

TariqMehmod

Programmer
Mar 4, 2004
100
PK
Dear All,

Here is an attempt to send text messages,images,contents to whatsapp.
No need of any third party dll etc.

I have tested all method before uploading.
All methods work fine.

Before testing any method, you must have Whatsapp installed on your system

Link

Please enter whatsapp number on International format like 923000000000
Do not include +, 00 or dashes.

*--------------------------------------------------
Method:1- How to send simple message
*--------------------------------------------------
Code: 
 Declare  Integer FindWindow In WIN32API String , String
Declare  Integer SetForegroundWindow In WIN32API Integer
Declare  Integer  ShowWindow  In WIN32API Integer , Integer
Declare Integer ShellExecute In shell32.Dll ;
	INTEGER hndWin, ;
	STRING cAction, ;
	STRING cFileName, ;
	STRING cParams, ;
	STRING cDir, ;
	INTEGER nShowWin

Local lt, lhwnd
cPhone=[923000000000]
ccMessage=[How are you sir?]
cmd='whatsapp://send?phone=&cPhone&text='+ccMessage
=ShellExecute(0, 'open', cmd,'', '', 1)
Wait "" Timeout 3
lt = "Whatsapp"
lhwnd = FindWindow (0, lt)
If lhwnd!= 0
	SetForegroundWindow (lhwnd)
	ShowWindow (lhwnd, 1)
	ox = Createobject ( "Wscript.Shell" )
	ox.sendKeys ( '{ENTER}' )
Else
	Messagebox ( "Whatsapp is not activated!" )
Endif

*--------------------------------------------------
Method:2- How to send an image file
*--------------------------------------------------
Code: 
 Do image_to_clip
** Declare Sleep
Declare Sleep In kernel32 Integer

Declare  Integer FindWindow In WIN32API String , String
Declare  Integer SetForegroundWindow In WIN32API Integer
Declare  Integer  ShowWindow  In WIN32API Integer , Integer
Declare Integer ShellExecute In shell32.Dll ;
	INTEGER hndWin, ;
	STRING cAction, ;
	STRING cFileName, ;
	STRING cParams, ;
	STRING cDir, ;
	INTEGER nShowWin

Local lt, lhwnd
cPhone=[923000000000]
cmd='whatsapp://send?phone=&cPhone'
=ShellExecute(0, 'open', cmd,'', '', 1)
Wait "" Timeout 3
lt = "Whatsapp"
lhwnd = FindWindow (0, lt)
If lhwnd!= 0
	SetForegroundWindow (lhwnd)
	ShowWindow (lhwnd, 1)
	ox = Createobject ( "Wscript.Shell" )
	ox.sendKeys ("^{v}")
sleep(2000)
	ox.sendKeys ( '{ENTER}' )

Else
	Messagebox ("Whatsapp is not activated!" )
Endif

Procedure image_to_clip
Declare Integer Sleep In kernel32 Integer
Declare Integer OpenClipboard In User32 Integer
Declare Integer CloseClipboard In User32
Declare Integer EmptyClipboard In User32
Declare Integer SetClipboardData In User32 Integer,Integer
Declare Integer LoadImage In WIN32API Integer,String,Integer,Integer,Integer,Integer
Declare Integer GetClipboardData In User32 Integer
Declare Integer GdipCreateBitmapFromHBITMAP In GDIPlus.Dll Integer, Integer, Integer @
Declare Integer GdipSaveImageToFile In GDIPlus.Dll Integer,String,String @,String @
Declare Long GdipCreateHBITMAPFromBitmap In GDIPlus.Dll Long nativeImage, Long @, Long
Declare Long GdipCreateBitmapFromFile In GDIPlus.Dll String FileName, Long @nBitmap
Declare Long    GdipCreateBitmapFromFile    In GDIPlus.Dll String FileName, Long @nBitmap
Declare Long CopyImage In WIN32API Long hImage, Long, Long, Long , Long

#Define CF_BITMAP 2
#Define CF_DIB 8
#Define IMAGE_BITMAP 0
#Define LR_LOADFROMFILE 16
#Define LR_MONOCHROME 0x00000001

Local xpict
m.xpict=Getpict()
If !Empty(m.xpict)
	m.ext=Proper(Justext(m.xpict))
	If !Inlist(m.ext,"Png","Jpg","Bmp","Gif","Tif")
		Messagebox('Please select only images',0+16,'Whatsapp',3000)
		Return
	Endif
Else
	Messagebox('Image not selected',0+64,'Whatsapp',3000)
	Return
Endif

Local m.oo
m.oo=Newobject("image")
m.oo.Picture=m.xpict
Local lnWidth,lnHeight
lnWidth=m.oo.Width
lnHeight=m.oo.Height

nBitmap=0
hbm=0
GdipCreateBitmapFromFile(Strconv(m.xpict+0h00,5),@nBitmap)
GdipCreateHBITMAPFromBitmap(nBitmap,@hbm,0)
lhBmp = CopyImage(hbm, 0, m.lnWidth, m.lnHeight,0)
If OpenClipboard(0)!= 0
	EmptyClipboard()
	SetClipboardData(CF_BITMAP, lhBmp)
	CloseClipboard()
Endif
Endproc

*--------------------------------------------------
Method:3- How to send Excel file as image
*--------------------------------------------------
Suppose I have this Excel File
C:\XLS\daily.xlsx

[URL unfurl="true"]https://res.cloudinary.com/engineering-com/raw/upload/v1606821683/tips/daily_wihilk.xlsx[/url]

I shall convert this file into image without loosing format first then later send to whatsapp
You must have following 3 file in same folder
gpimage.FXP,gpimage.h,gpimage.prg
Download attachment that have all those 3 files

The following codes will generate a bmp file like this

[URL unfurl="true"]https://res.cloudinary.com/engineering-com/image/upload/v1606821894/tips/9e97ccb8-f290-4ad1-9383-76281d5548ce_dx4qyv.bmp[/url]

Code: 
 Do excel2image

Function excel2image
xflname="" && Get image file name
ahour=Padl(Alltrim(Str(Hour(Datetime()))),2,'0')
amin=Padl(Alltrim(Str(Minute(Datetime()))),2,'0')
xflname=Alltrim("Tailor_")+Alltrim(Dtos(Date()))+"_"+ahour+amin

lcXLS =[C:\xls\daily.xlsx]
If Empty(lcXLS)
	Messagebox('Excel file not found',0+16,'System')
	Return
Endif

Local oForm
oForm = Createobject("Form")

With oForm
	.Height = 550
	.Width = 360
	.AutoCenter=.T.
	.Caption=m.xflname
	.MinButton=.F.
	.MaxButton=.F.
	.AlwaysOnTop=.T.
	.Newobject("ExcelObject","oleExcelObject")
	With .ExcelObject
		.Left = 0
		.Top = 0
		.Width = .Parent.Width - 10
		.Height = .Parent.Height - 10
		.Visible = .T.
	Endwith
	.Newobject("Timer1","oTimer")
Endwith

oForm.Show(1)
Define Class oleExcelObject As OleControl
	OleClass ="Excel.Sheet"  && Server name
	OLETypeAllowed = 0      && Linked
	DocumentFile = lcXLS && This file should exist
Enddefine

Define Class oTimer As Timer
	Interval=8000
	Procedure Timer
	This.Enabled = .F.
	Do ScreenShot With This.Parent
	This.Enabled = .T.
Enddefine

Procedure ScreenShot
Lparameters oForm

#INCLUDE gpImage.h

If Not "gpImage" $ Set("Procedure")
	Set Procedure To gpImage Additive
Endif

GDIP = Createobject("gpInit")
img = Createobject("gpImage")
img.Capture(oForm.HWnd)
Local lnTitleHeight, lnLeftBorder, lnTopBorder
lnTitleHeight = Sysmetric(9)
lnLeftBorder = Sysmetric(3)
lnTopBorder = Sysmetric(4)
img.Crop(lnLeftBorder, lnTitleHeight + lnTopBorder, ;
	img.ImageWidth - (lnLeftBorder * 2), ;
	img.ImageHeight - (lnTitleHeight + (lnTopBorder * 2)))
img.SaveasBMP('C:\Xls'+'\'+m.xflname)
img = Null
oForm.Release

Do image2Clip
Do send2whatsapp

Endfunc

Function image2Clip
Declare Integer Sleep In kernel32 Integer
Declare Integer OpenClipboard In User32 Integer
Declare Integer CloseClipboard In User32
Declare Integer EmptyClipboard In User32
Declare Integer SetClipboardData In User32 Integer,Integer
Declare Integer LoadImage In WIN32API Integer,String,Integer,Integer,Integer,Integer
Declare Integer GetClipboardData In User32 Integer
Declare Integer GdipCreateBitmapFromHBITMAP In GDIPlus.Dll Integer, Integer, Integer @
Declare Integer GdipSaveImageToFile In GDIPlus.Dll Integer,String,String @,String @
Declare Long GdipCreateHBITMAPFromBitmap In GDIPlus.Dll Long nativeImage, Long @, Long
Declare Long GdipCreateBitmapFromFile In GDIPlus.Dll String FileName, Long @nBitmap
Declare Long  GdipCreateBitmapFromFile    In GDIPlus.Dll String FileName, Long @nBitmap
Declare Long CopyImage In WIN32API Long hImage, Long, Long, Long , Long

#Define CF_BITMAP 2
#Define CF_DIB 8
#Define IMAGE_BITMAP 0
#Define LR_LOADFROMFILE 16
#Define LR_MONOCHROME 0x00000001 && Creates a new monochrome image. if used
Local m.xpict

m.xpict='C:\XLS'+'\'+m.xflname+'.bmp'
Messagebox(m.xpict)

If !Empty(m.xpict)
	m.ext=Proper(Justext(m.xpict))
	If !Inlist(m.ext,"Png","Jpg","Bmp","Gif","Tif")
		Messagebox('Please select only images')
		Return
	Endif
Else
	Messagebox('Image not selected')
	Return
Endif

Local m.oo
m.oo=Newobject("image")
m.oo.Picture=m.xpict
Local lnWidth,lnHeight
lnWidth=m.oo.Width
lnHeight=m.oo.Height

*Save the bitmap file to the clipboard
nBitmap=0
hbm=0
GdipCreateBitmapFromFile(Strconv(m.xpict+0h00,5),@nBitmap)
GdipCreateHBITMAPFromBitmap(nBitmap,@hbm,0)
lhBmp = CopyImage(hbm, 0, m.lnWidth, m.lnHeight,0)
If OpenClipboard(0)!= 0
	EmptyClipboard()
	SetClipboardData(CF_BITMAP, lhBmp)
	CloseClipboard()
Endif
Endfunc

Function send2whatsapp
* Finally send this newly created image to whatsapp
Declare  Integer FindWindow In WIN32API String , String
Declare  Integer SetForegroundWindow In WIN32API Integer
Declare  Integer  ShowWindow  In WIN32API Integer , Integer
Declare Integer ShellExecute In shell32.Dll ;
	INTEGER hndWin, ;
	STRING cAction, ;
	STRING cFileName, ;
	STRING cParams, ;
	STRING cDir, ;
	INTEGER nShowWin

Local lt, lhwnd
cPhone=[923000000000]
cmd='whatsapp://send?phone=&cPhone'
=ShellExecute(0, 'open', cmd,'', '', 1)
Wait "" Timeout 3
lt = "Whatsapp"
lhwnd = FindWindow (0, lt)
If lhwnd!= 0
	SetForegroundWindow (lhwnd)
	ShowWindow (lhwnd, 1)
	ox = Createobject ( "Wscript.Shell" )
	ox.SendKeys ("^{v}")
Sleep(2000)
	ox.SendKeys ( '{ENTER}' )
Else
	Messagebox ( "Whatsapp is not activated!" )
Endif
Endfunc

*--------------------------------------------------
Method:4- How to send Bulk messages
*--------------------------------------------------
We shall create some data first

Code: 
 Create Cursor clients(mobile c(12))
Insert Into clients Values('923000000000')
Insert Into clients Values('923000000000')
Insert Into clients Values('923000000000')
Go Top
Scan
	Scatter Memv
	cPhone=ALLTRIM(m.mobile)
	cMessage=Alltrim('This is sales promotion message')

	Declare  Integer FindWindow In WIN32API String , String
	Declare  Integer SetForegroundWindow In WIN32API Integer
	Declare  Integer  ShowWindow  In WIN32API Integer , Integer
	Declare Integer ShellExecute In shell32.Dll ;
		INTEGER hndWin, ;
		STRING cAction, ;
		STRING cFileName, ;
		STRING cParams, ;
		STRING cDir, ;
		INTEGER nShowWin
	Local lt, lhwnd
	cmd='whatsapp://send?phone=&cPhone&text=' + cMessage
	=ShellExecute(0, 'open', cmd,'', '', 1)
	Wait "" Timeout 8 && 8 seconds internal in every message
	lt = "Whatsapp"
	lhwnd = FindWindow (0, lt)
	If lhwnd!= 0
		SetForegroundWindow (lhwnd)
		ShowWindow (lhwnd, 1)
		ox = Createobject ( "Wscript.Shell" )
		ox.sendKeys ( '{ENTER}' )
	Else
		Messagebox ( "Whatsapp is not activated!" )
	Endif
Endscan

*--------------------------------------------------
Method:5- How to send contents of text file
*--------------------------------------------------

Code: 
 cFile=Getfile('txt')
_Cliptext=Filetostr(cFile)

Declare  Integer FindWindow In WIN32API String , String
Declare  Integer SetForegroundWindow In WIN32API Integer
Declare  Integer  ShowWindow  In WIN32API Integer , Integer
Declare Integer ShellExecute In shell32.Dll ;
	INTEGER hndWin, ;
	STRING cAction, ;
	STRING cFileName, ;
	STRING cParams, ;
	STRING cDir, ;
	INTEGER nShowWin

Local lt, lhwnd
cPhone=[923000000000]
cmd='whatsapp://send?phone=&cPhone'
=ShellExecute(0, 'open', cmd,'', '', 1)
Wait "" Timeout 3
lt = "Whatsapp"
lhwnd = FindWindow (0, lt)
If lhwnd!= 0
	SetForegroundWindow (lhwnd)
	ShowWindow (lhwnd, 1)
	ox = Createobject ( "Wscript.Shell" )
	ox.sendKeys ("^{v}")
Sleep(2000)
	ox.sendKeys ( '{ENTER}' )
Else
	Messagebox ( "Whatsapp is not activated!" )
Endif

*--------------------------------------------------
Method:6- How to send Result Cards
*--------------------------------------------------
Suppose you are a principal of a school and want to send customized result card to parents.

Code: 
 Create Cursor result(rollno N(3),student c(15),Chem N(3),phy N(3),bio N(3),;
	eng N(3),math N(3),t_marks N(3),o_marks N(3),rem c(10),mobile c(13))
Insert Into result Values(1,'Ahmad Ali',78,25,33,85,50,500,271,'Pass','923000000000')
Insert Into result Values(1,'Zahid Mahmood',36,74,66,55,80,500,311,'Pass','92345000000')


Go Top
Scan
	Scatter Memv
	cPhone=Alltrim(m.mobile)

	cMessage='*Result Card*';
		+ '%0A'+'%0A';
		+ m.student;
		+ '%0A'+'%0A'+'Chem='+transform(m.Chem);
		+ '%0A'+'Bio='+transform(m.bio);
		+ '%0A'+'Phy='+transform(m.phy);
		+ '%0A'+'Eng='+transform(m.eng);
		+ '%0A'+'Math='+transform(m.math);
		+ '%0A'+'%0A'+'Total='+transform(m.t_marks);
		+ '%0A'+'Obtained='+Alltrim(Str(m.o_marks));
		+  '%0A' +'%0A'+'Remarks='+'*'+Alltrim(m.rem)+'*';
		+ '%0A' ;
		+ Replicate('-',20);
		+ '%0A'+'Principal:';
		+ '%0A'+'Allied Public School'

	Declare Sleep In kernel32 Integer
	Declare  Integer FindWindow In WIN32API String , String
	Declare  Integer SetForegroundWindow In WIN32API Integer
	Declare  Integer  ShowWindow  In WIN32API Integer , Integer
	Declare Integer ShellExecute In shell32.Dll ;
		INTEGER hndWin, ;
		STRING cAction, ;
		STRING cFileName, ;
		STRING cParams, ;
		STRING cDir, ;
		INTEGER nShowWin
	Local lt, lhwnd
	cmd='whatsapp://send?phone=&cPhone&text=' + cMessage
	=ShellExecute(0, 'open', cmd,'', '', 1)
	Sleep(2000)
	lt = "Whatsapp"
	lhwnd = FindWindow (0, lt)
	If lhwnd!= 0
		SetForegroundWindow (lhwnd)
		ShowWindow (lhwnd, 1)
		ox = Createobject ( "Wscript.Shell" )
		ox.sendKeys ( '{ENTER}' )
	Else
		Messagebox ("Whatsapp is not activated!" )
	Endif
Endscan

Parents will receive this message on their whatsapp.

1b167063-4df9-4775-be81-b6bf3f251f4a_nbhyam.png


Same like this, while using an accounting system you can send Ledger to your customers also.

If you want to be more intelligent, don't want to use columns name and values in message then play like this

Code: 
 FOR lnCnt = 1 TO FCOUNT()
  *** Get the Field Name
  lcField = FIELD( lnCnt )
  *** Get the field Value
  luFVal = &lcField
 
  *** Now do whatever you want with it
  ? lcField, luFVal
NEXT

see result

62dd418d-2d53-4643-a8da-a3ba450c1541_p5ptxm.png


*---------------------------------------------------
* Method:7- How to send unicode message from text file
*--------------------------------------------------

Some users asked me they want to send unicode message to whatsapp.
They have text file that contains data in their local language.

Suppose I have text file written our national lanugage URDU.
If I copy data from this file to VFP then data will be appear like this
?? ???? ??? ????? ???? ???? ??? ?? ???? ?????. ?? ?? ???? ????? ??

In this case I could not send this data to whats app with VFP codes

To make this data readable, I used my codes with this link


Here is complete routine

Code: 
 aa=Fullpath(Getfile('txt'))
tcUnicodeText=Strconv(Filetostr(aa), 5, 1256, 1)
*-------------------------------------------------
Do CopyUnicodeText2Clipboard With tcUnicodeText

Declare Sleep In kernel32 Integer

Declare  Integer FindWindow In WIN32API String , String
Declare  Integer SetForegroundWindow In WIN32API Integer
Declare  Integer  ShowWindow  In WIN32API Integer , Integer
Declare Integer ShellExecute In shell32.Dll ;
	INTEGER hndWin, ;
	STRING cAction, ;
	STRING cFileName, ;
	STRING cParams, ;
	STRING cDir, ;
	INTEGER nShowWin

Local lt, lhwnd
cPhone=[923226857062]
cmd='whatsapp://send?phone=&cPhone'
=ShellExecute(0, 'open', cmd,'', '', 1)
Wait "" Timeout 3
lt = "Whatsapp"
lhwnd = FindWindow (0, lt)
If lhwnd!= 0
	SetForegroundWindow (lhwnd)
	ShowWindow (lhwnd, 1)
	ox = Createobject ( "Wscript.Shell" )
	ox.sendKeys ("^{v}")
	sleep(2000)
	ox.sendKeys ( '{ENTER}' )
Else
	Messagebox ("Whatsapp is not activated!" )
Endif


&& Copy Unicode text into Clipboard
Function CopyUnicodeText2Clipboard(tcUnicodeText)
Local lnDataLen, lcDropFiles, llOk, i, lhMem, lnPtr, lcUnicodeText

#Define CF_UNICODETEXT      13
&&  Global Memory Variables with Compile Time Constants
#Define GMEM_MOVABLE 	0x0002
#Define GMEM_ZEROINIT	0x0040
#Define GMEM_SHARE		0x2000

&& Load required Windows API functions
=LoadApiDlls()

llOk = .T.
lcUnicodeText = tcUnicodeText + Chr(0)+Chr(0)
lnDataLen = Len(lcUnicodeText)
&& Copy Unicode text into the allocated memory
lhMem = GlobalAlloc(GMEM_MOVABLE+GMEM_ZEROINIT+GMEM_SHARE, lnDataLen)
lnPtr = GlobalLock(lhMem)
=CopyFromStr(lnPtr, @lcUnicodeText, lnDataLen)
=GlobalUnlock(lhMem)
&& Open clipboard and store Unicode text into it
llOk = (OpenClipboard(0) <> 0)
If llOk
	=EmptyClipboard()
	llOk = (SetClipboardData(CF_UNICODETEXT, lhMem) <> 0)
&& If call to SetClipboardData() is successful, the system will take ownership of the memory
&&   otherwise we have to free it
	If Not llOk
		=GlobalFree(lhMem)
	Endif
&& Close clipboard
	=CloseClipboard()
Endif
Return llOk

Function LoadApiDlls
&&  Clipboard Functions
Declare Long OpenClipboard In WIN32API Long HWnd
Declare Long CloseClipboard In WIN32API
Declare Long EmptyClipboard In WIN32API
Declare Long SetClipboardData In WIN32API Long uFormat, Long Hmem
&&  Memory Management Functions
Declare Long GlobalAlloc In WIN32API Long wFlags, Long dwBytes
Declare Long GlobalFree In WIN32API Long Hmem
Declare Long GlobalLock In WIN32API Long Hmem
Declare Long GlobalUnlock In WIN32API Long Hmem
Declare Long RtlMoveMemory In WIN32API As CopyFromStr Long lpDest, String @lpSrc, Long iLen
RETURN

The result of above codes on whatsapp is as follows

27fc7e46-4243-4560-8d57-c798d45c42b5_unrzoy.png


You can read more about Unicode and Locale


*---------------------------------------------------
Method:8- How to send POS Invoice
*--------------------------------------------------
Today a user asked how to send POS Invoice/bill to customer on the spot.
It was good idea to get customers focus.
There are many issues to use custom page in VFP reports.
So there was need to send report on whatsapp with a small size to fit on Mobile Screen.

You must have following files in same folder before executing codes
(Files are in second attachment)

Suppose I want to send this invoice to customer.
a2e6a2c7-2089-46c1-9dde-f6c369c6167c_ngi84t.png


To achieve this goal please give a try to following codes:
Code: 
 Create Cursor pos(items c(25),qty N(3),price N(3),Total N(4))

Insert Into pos Values('KAJU SADA 50G',1,150,150)
Insert Into pos Values('Kaju Roasted 50G',1,170,170)
Insert Into pos Values('AKHROT MAGAZ 50G',2,90,180)
Insert Into pos Values('Pista Namkeen 100G',1,250,250)
Insert Into pos Values('SANGARI NISRI 100G',1,30,30)
Insert Into pos Values('GANDAM DALYA 500G',1,50,50)
Insert Into pos Values('PODINA TIKI 50G',1,25,25)
Insert Into pos Values('CHAR MAGAZ 100G',1,65,65)
Insert Into pos Values('HARMONY LEMON 150G',1,65,65)
Insert Into pos Values('L C KA BEEG 100G',1,40,	40)
Insert Into pos Values('SERVING CUP BACHA',1,150,150)

#include excel.h
#Define xlA1 1
#Define xlR1C1 -4150
#Define xlLastCell 11

bError = .F.
On Error bError = .T.
loExcel = Createobj("excel.application")
If bError
	Messagebox("Error")
	Return
Endif
*MessageBox("Version: " + loExcel.Version) && version number
On Error

xflname="" && Get Excel file name
ahour=Padl(Alltrim(Str(Hour(Datetime()))),2,'0')
amin=Padl(Alltrim(Str(Minute(Datetime()))),2,'0')
xflname=Alltrim("Tailor_")+Alltrim(Dtos(Date()))+"_"+ahour+amin
xflname=Alltrim("Tailor_")+Alltrim(Dtos(Date()))+"_"+ahour+amin


Select pos
Copy To 'C:\Xls\'+Alltrim(xflname)+Alltrim('.xls') Type Xl5
rec1=Reccount()
rec2=Reccount()+6

loExcel = Createobject("Excel.Application")
loworkbook = loExcel.workbooks.Open('C:\Xls\'+Alltrim(xflname))
losheet = loworkbook.sheets(1)

* insert 4 empty rows before data
With loExcel.activeworkbook.activesheet
	.usedrange.RowHeight = 15
	.Rows("1:4").Insert()
Endwith

&& First Line
losheet.Range("A1").Value=[Ehsas Mart]
With loExcel.Range("A1:D1")
	.horizontalalignment = xlcenter
	.verticalalignment = xlcenter
	.wraptext = false
	.Orientation = 0
	.shrinktofit = false
	.mergecells = true

	.Font.Color = Rgb(128,64,64)
	.Font.Name = 'Verdana'
	.Font.bold = .T.
	.Font.Size = 16
	.RowHeight=22
Endwith

&& Second Line
losheet.Range("A2").Value=[Opp. Government Printing Press]
With loExcel.Range("A2:D2")
	.horizontalalignment = xlcenter
	.verticalalignment = xlcenter
	.wraptext = false
	.Orientation = 0
	.shrinktofit = false
	.mergecells = true

	.Font.Color = Rgb(0,0,0)
	.Font.Name = 'Verdana'
*  .FONT.Bold = .T.
	.Font.Size = 10
	.RowHeight=15
Endwith

&& Third line
losheet.Range("A3").Value=[Bahawalpur, Ph.062-2504438]
With loExcel.Range("A3:D3")
	.horizontalalignment = xlcenter
	.verticalalignment = xlcenter
	.wraptext = false
	.Orientation = 0
	.shrinktofit = false
	.mergecells = true

	.Font.Color = Rgb(0,0,0)
	.Font.Name = 'Verdana'
*	.Font.bold = .T.
	.Font.Size = 10
	.RowHeight=15
Endwith

&& Fourth line
losheet.Range("A4").Value=[21-Nov-2020 5:33pm        Invoice No. 166]
With loExcel.Range("A4:D4")
	.horizontalalignment = xlleft
	.verticalalignment = xlcenter
	.wraptext = false
	.Orientation = 0
	.shrinktofit = false
	.mergecells = true

	.Font.Color = Rgb(50,50,150)
	.Font.Name = 'Verdana'
	.Font.Size = 8
	.Font.bold = .T.
	.Font.Italic = 1
	.RowHeight=15

Endwith

* Body Font name
rec5=5
With losheet.Range("A"+Alltrim(Str(rec5))+":"+"D"+Alltrim(Str(rec2)))
	.Font.Name="Verdana"
Endwith

&& Foramt
rec4=4
losheet.Range("D"+Alltrim(Str(rec4))+":"+"D"+Alltrim(Str(rec2))).numberformat = "#[=0];###,###"

&& Headings
losheet.Range("A5").Value = "Name"
losheet.Range("B5").Value = "Qty"
losheet.Range("C5").Value = "Price"
losheet.Range("D5").Value = "Total"
losheet.Columns(1).AutoFit()

* Border of heading row
With loExcel.sheets(1).Range("A5:D5")
	.BorderS(xlEdgeLeft).LineStyle = xlContinuous
	.BorderS(xlEdgeTop).LineStyle = xlContinuous
	.BorderS(xlEdgeBottom).LineStyle = xlContinuous
	.BorderS(xlEdgeRight).LineStyle = xlContinuous
Endwith

* Heading Row
With loExcel.sheets(1).Range("A5:D5")
	.Font.Name = 'Verdana'
	.Font.bold = .T.
	.RowHeight=20
	.Font.Color = Rgb(10,25,245)
*	.interior.Color = Rgb(10,235,245)
	.interior.Color = 0x00FFFF
	.horizontalalignment = -4108
	.verticalalignment = -4108
Endwith

&& Summary Row
With losheet.Range("A"+Alltrim(Str(rec2))+":"+"D"+Alltrim(Str(rec2)))
	.RowHeight = 20
	.Font.Color = Rgb(0,0,255)
	.interior.Color = Rgb(204,255,204)
	.Font.Name = 'Verdana'
	.Font.bold = .T.
	.horizontalalignment = -4108
	.verticalalignment = -4108
Endwith

rec3=rec2-1
&& Summary with Formula
losheet.Range("A"+Alltrim(Str(rec2))).Value = "TOTAL"
losheet.Range("b"+Alltrim(Str(rec2))).Formula = "=SUM(b2:b" + Alltrim(Str(rec3)) + ")"
losheet.Range("d"+Alltrim(Str(rec2))).Formula = "=SUM(d2:d" + Alltrim(Str(rec3)) + ")"

* column data autofit
For lni = 1 To Fcount("pos")
	lccolumn = Chr(lni+96)+":"+Chr(lni+96)
	loExcel.Columns(lccolumn).entirecolumn.AutoFit
Endfor

* Last Row/Column
lnLastRow = losheet.usedrange.Rows.Count
lnLastCol = losheet.usedrange.Columns.Count
thanks=lnLastRow+3
losheet.Range("A"+Alltrim(Str(thanks))).Value = "Thanks for visiting"

* Borders
loExcel.activewindow.displaygridlines = .F.

&& page margin
Local plportrait, pctitlerange, pllegal, pcprintarea, lnmargin
plportrait=.T.
pctitlerange="L"

With losheet.pagesetup
	If plportrait = .T.
		.Orientation = 1
	Else
		.Orientation = 2
	Endif

	If pllegal = .T.
		.Papersize = 5
	Else
		.Papersize = 1
	Endif
*	.PaperSize = 5 && 5 for legal 1 for landscap
*	.Orientation = 1  && 1 for portrati 2 for landscap
	.topmargin     = loExcel.inchestopoints(0.6)
	.bottommargin     = loExcel.inchestopoints(0.8)
	.leftmargin     = loExcel.inchestopoints(1)
	.rightmargin     = loExcel.inchestopoints(0.6)

	.headermargin     = loExcel.inchestopoints(0.1)
	.footermargin     = loExcel.inchestopoints(0.1)

	.centerhorizontally = .T.
	.Zoom = .F.
	.fittopageswide = 1
	.fittopagestall = .F.
	If Type('pcTitleRange') <> 'L'
		.printtitlerows = losheet.Range("A5:d5").address
	Endif
	If Type('pcPrintArea') <> 'L'
		.printarea = pcprintarea
	Endif
Endwith

&& Page Footer
losheet.pagesetup.rightfooter = "Page &P of &N"

*loExcel.Range("b6").Select
*loExcel.activewindow.freezepanes = .T. && freeze the panes
loExcel.Range("a1").Select

loExcel.activeworkbook.Save
loExcel.displayalerts = .F.
*loExcel.Visible = .T. && display Excel
*losheet.printpreview()
loExcel.Quit()
Release loExcel
Release All Like lo*
loExcel = .Null.

Do excel2image
Function excel2image

lcXLS ='C:\Xls\'+Alltrim(xflname)+'.xls'

If Empty(lcXLS)
	Messagebox('Excel file not found',0+16,'System')
	Return
Endif

Local oForm
oForm = Createobject("Form")

With oForm
	.Height = 550
	.Width = 360
	.AutoCenter=.T.
	.Caption=m.xflname
	.MinButton=.F.
	.MaxButton=.F.
	.AlwaysOnTop=.T.
        .Backcolor=RGB(255,255,255)
	.Newobject("ExcelObject","oleExcelObject")

	With .ExcelObject
		.Left = 10
		.Top = 10
		.Width = .Parent.Width - 30
		.Height = .Parent.Height - 30
		.Visible = .T.
	Endwith

	.Newobject("Timer1","oTimer")

Endwith

oForm.Show(1)
Define Class oleExcelObject As OleControl
	OleClass ="Excel.Sheet"
	OLETypeAllowed = 0
	DocumentFile = lcXLS
Enddefine

Define Class oTimer As Timer
	Interval=3000
	Procedure Timer
	This.Enabled = .F.
	Do ScreenShot With This.Parent
	This.Enabled = .T.
Enddefine

Procedure ScreenShot
Lparameters oForm

#INCLUDE gpImage.h

If Not "gpImage" $ Set("Procedure")
	Set Procedure To gpImage Additive
Endif

GDIP = Createobject("gpInit")
img = Createobject("gpImage")
img.Capture(oForm.HWnd)
Local lnTitleHeight, lnLeftBorder, lnTopBorder
lnTitleHeight = Sysmetric(9)
lnLeftBorder = Sysmetric(3)
lnTopBorder = Sysmetric(4)
img.Crop(lnLeftBorder, lnTitleHeight + lnTopBorder, ;
	img.ImageWidth - (lnLeftBorder * 2), ;
	img.ImageHeight - (lnTitleHeight + (lnTopBorder * 2)))
img.SaveasBMP('C:\Xls'+'\'+m.xflname)
img = Null
oForm.Release

Do image2Clip
Do send2whatsapp

Endfunc

Function image2Clip
Declare Integer Sleep In kernel32 Integer
Declare Integer OpenClipboard In User32 Integer
Declare Integer CloseClipboard In User32
Declare Integer EmptyClipboard In User32
Declare Integer SetClipboardData In User32 Integer,Integer
Declare Integer LoadImage In WIN32API Integer,String,Integer,Integer,Integer,Integer
Declare Integer GetClipboardData In User32 Integer
Declare Integer GdipCreateBitmapFromHBITMAP In GDIPlus.Dll Integer, Integer, Integer @
Declare Integer GdipSaveImageToFile In GDIPlus.Dll Integer,String,String @,String @
Declare Long GdipCreateHBITMAPFromBitmap In GDIPlus.Dll Long nativeImage, Long @, Long
Declare Long GdipCreateBitmapFromFile In GDIPlus.Dll String FileName, Long @nBitmap
Declare Long  GdipCreateBitmapFromFile    In GDIPlus.Dll String FileName, Long @nBitmap
Declare Long CopyImage In WIN32API Long hImage, Long, Long, Long , Long

#Define CF_BITMAP 2
#Define CF_DIB 8
#Define IMAGE_BITMAP 0
#Define LR_LOADFROMFILE 16
#Define LR_MONOCHROME 0x00000001 && Creates a new monochrome image. if used
Local m.xpict

m.xpict='C:\XLS'+'\'+m.xflname+'.bmp'


If !Empty(m.xpict)
	m.ext=Proper(Justext(m.xpict))
	If !Inlist(m.ext,"Png","Jpg","Bmp","Gif","Tif")
		Messagebox('Please select only images')
		Return
	Endif
Else
	Messagebox('Image not selected')
	Return
Endif

Local m.oo
m.oo=Newobject("image")
m.oo.Picture=m.xpict
Local lnWidth,lnHeight
lnWidth=m.oo.Width
lnHeight=m.oo.Height

*Save the bitmap file to the clipboard
nBitmap=0
hbm=0
GdipCreateBitmapFromFile(Strconv(m.xpict+0h00,5),@nBitmap)
GdipCreateHBITMAPFromBitmap(nBitmap,@hbm,0)
lhBmp = CopyImage(hbm, 0, m.lnWidth, m.lnHeight,0)
If OpenClipboard(0)!= 0
	EmptyClipboard()
	SetClipboardData(CF_BITMAP, lhBmp)
	CloseClipboard()
Endif
Endfunc

Function send2whatsapp
* Finally send this newly created image to whatsapp
Declare  Integer FindWindow In WIN32API String , String
Declare  Integer SetForegroundWindow In WIN32API Integer
Declare  Integer  ShowWindow  In WIN32API Integer , Integer
Declare Integer ShellExecute In shell32.Dll ;
	INTEGER hndWin, ;
	STRING cAction, ;
	STRING cFileName, ;
	STRING cParams, ;
	STRING cDir, ;
	INTEGER nShowWin

Local lt, lhwnd
cPhone=[92300000000]
cmd='whatsapp://send?phone=&cPhone'
=ShellExecute(0, 'open', cmd,'', '', 1)
Wait "" Timeout 3
lt = "Whatsapp"
lhwnd = FindWindow (0, lt)
If lhwnd!= 0
	SetForegroundWindow (lhwnd)
	ShowWindow (lhwnd, 1)
	ox = Createobject ( "Wscript.Shell" )
	ox.SendKeys ("^{v}")
Sleep(2000)
	ox.SendKeys ( '{ENTER}' )
Else
	Messagebox ( "Whatsapp is not activated!" )
Endif
Endfunc

[URL unfurl="true"]https://res.cloudinary.com/engineering-com/image/upload/v1606822489/tips/dd2f62ba-129f-478d-8135-f13411b499df_dor8bc.bmp[/url]

You can apply more formatting to excel file to make more better look.

*---------------------------------------------------
Method:9- How to send System Generated Reports (frx)
*--------------------------------------------------

Code: 
 Clear
Set Safety Off

Public yout

Do select_frx
Do image_to_clip

Procedure select_frx
m.yrep=Getenv("TEMP")
Set Defa To (yrep)

xflname = DTOC(DATE(),1)+[_]+CHRTRAN(TIME(),[:],[]) 

m.yout=m.yrep+'\'+xflname

If !Directory(m.yout)
	Md (m.yrep+'\'+xflname)
Endi

Local afile
*afile=Getfile('frx')

&& you can this following line for testing purpose
afile=(_Samples + "\Solution\Reports\Colors.frx")

If !Empty(m.afile)
	m.ext=Lower(Justext(m.afile))
	If m.ext<>[frx]
		Messagebox('Please select only frx',0+16,'Whatsapp',3000)
		Return
	Endif
Else
	Messagebox('Report not selected',0+64,'Whatsapp',3000)
	Return
Endif

#Define OutputNothing -1
#Define OutputEMF 100
#Define OutputJPEG 102
#Define OutputGIF 103
#Define OutputPNG 104
#Define OutputBMP 105
#Define OutputTIFF 101
#Define OutputTIFFM 201

oListener =Newobject("ReportListener")
oListener.ListenerType=3
Report Form (afile) Preview Object oListener

myext=[.]+Alltrim('JPG')
ntype=OutputJPEG
m.yout=m.yout

For nPageno=1 To oListener.PageTotal
	cOutputFile = m.yout+"\myreport"+Trans(nPageno)+myext
	oListener.OutputPage(nPageno, cOutputFile,m.ntype)
Next

*!*	If Not Inlist(ntype,OutputTIFFM,1000,1001)
*!*		Run/N "explorer"  &yout
*!*	Endi

reporlistener=Null
Release ReportListener
Endproc

Procedure image_to_clip

Declare Integer Sleep In kernel32 Integer
Declare Integer OpenClipboard In User32 Integer
Declare Integer CloseClipboard In User32
Declare Integer EmptyClipboard In User32
Declare Integer SetClipboardData In User32 Integer,Integer
Declare Integer LoadImage In WIN32API Integer,String,Integer,Integer,Integer,Integer
Declare Integer GetClipboardData In User32 Integer
Declare Integer GdipCreateBitmapFromHBITMAP In GDIPlus.Dll Integer, Integer, Integer @
Declare Integer GdipSaveImageToFile In GDIPlus.Dll Integer,String,String @,String @
Declare Long GdipCreateHBITMAPFromBitmap In GDIPlus.Dll Long nativeImage, Long @, Long
Declare Long GdipCreateBitmapFromFile In GDIPlus.Dll String FileName, Long @nBitmap
Declare Long    GdipCreateBitmapFromFile    In GDIPlus.Dll String FileName, Long @nBitmap
Declare Long CopyImage In WIN32API Long hImage, Long, Long, Long , Long

Declare Sleep In kernel32 Integer
Declare  Integer FindWindow In WIN32API String , String
Declare  Integer SetForegroundWindow In WIN32API Integer
Declare  Integer  ShowWindow  In WIN32API Integer , Integer
Declare Integer ShellExecute In shell32.Dll ;
	INTEGER hndWin, ;
	STRING cAction, ;
	STRING cFileName, ;
	STRING cParams, ;
	STRING cDir, ;
	INTEGER nShowWin

#Define CF_BITMAP 2
#Define CF_DIB 8
#Define IMAGE_BITMAP 0
#Define LR_LOADFROMFILE 16
#Define LR_MONOCHROME 0x00000001

fso=Createobject("scripting.filesystemobject")
fld=fso.getfolder(yout)

For Each fil In fld.Files

	Local m.oo
	m.oo=Newobject("image")
	m.oo.Picture=m.yout+"\"+(fil.Name)

	Local lnWidth,lnHeight
	lnWidth=m.oo.Width
	lnHeight=m.oo.Height

	nBitmap=0
	hbm=0
	GdipCreateBitmapFromFile(Strconv(m.yout+"\"+(fil.Name)+0h00,5),@nBitmap)
	GdipCreateHBITMAPFromBitmap(nBitmap,@hbm,0)
	lhBmp = CopyImage(hbm, 0, m.lnWidth, m.lnHeight,0)
	If OpenClipboard(0)!= 0
		EmptyClipboard()
		SetClipboardData(CF_BITMAP, lhBmp)
		CloseClipboard()
	Endif

	Local lt, lhwnd
	cPhone=[923000000000]
	cmd='whatsapp://send?phone=&cPhone'
	=ShellExecute(0, 'open', cmd,'', '', 1)
	Wait "" Timeout 3
	lt = "Whatsapp"
	lhwnd = FindWindow (0, lt)
	If lhwnd!= 0
		SetForegroundWindow (lhwnd)
		ShowWindow (lhwnd, 1)
		ox = Createobject ( "Wscript.Shell" )
		ox.sendKeys ("^{v}")
		Sleep(2000)
		ox.sendKeys ( '{ENTER}' )

	Else
		Messagebox ("Whatsapp is not activated!" )
	Endif
Next

Endproc

You can use following formats with above codes
HTML,XML,TIF,EMF,JPG,GIF,PNG,BMP,DOC,XLS


Thanks Sir GriffMG and Mike Lewis for providing me support specially excel2image.

I shall welcome your feedback to make this integration more strong.

Thanks and best Regards





 
Sort by date Sort by votes
Respected Sir, Mike Lewis
I am trying my best to attach PDF with message.
Facing several issues still.
Regards
 
Upvote 0 Downvote
Hello,

maybe a conversion from pdf to image (JPG, Bmp,..) may help.

There are many tools (dll , commandline, free or commercial) which may do this from vfp :

or
maybe irfanview commandlinemode can do (not tested)

or
there is code in c# to use ghostscript (but not in vfp)


regards
tom
 
Upvote 0 Downvote
I have installed Whatsapp window but your program is not detect of the same why?
 
Upvote 0 Downvote
I have installed Whatsapp on my computer but your program is not detecting the window why?
 
Upvote 0 Downvote
I will also be careful not to click the link by Jain Kumar above.
Whenever winnings are announced, they are winnings generated by fraud, and those winnings certainly do not end up with the recipient of the mail.
The risk of viruses is also great - unfortunately with every download.
Hands off!
Thanks for your warning, Mike.
Klaus

Peace worldwide - it starts here...
 
Upvote 0 Downvote
I took the risk and downloaded the file by JainKumar.

It is a Foxpro 6 executable as I found out by a Hex Editor, but I didn't execute it. I don't know what you expect JainKumar, but you surely can't motivate someone here to crack a software for you or to start something of unknown nature, likely malware.

Chriss
 
Upvote 0 Downvote
Fortunately, the forum management have now deleted the post containing the link. This is the second time JainKumar has posted this kind of link; the first one was also removed.

This might be entirely innocent, but it is right to play it safe.

Mike

__________________________________
Mike Lewis (Edinburgh, Scotland)

Visual FoxPro articles, tips and downloads
 
Upvote 0 Downvote
Hi, Where a i can find the excel.h file ?. i've searching but it's not in the examples.
 
Upvote 0 Downvote
Dear Tariq You rocked with whatsapp query i have
on query after attaching image i have to press enter
is there any way where i do not have to press enter
and it will return to my vfp applicaton
Thanks in advance
 
Upvote 0 Downvote
dear tariq great work but i have an query about attached image used in memory until vfp run in current instance. if want to release memory after sending message i can't. any solution for this. error no 1705 if i delete the file what i have send.
 
Upvote 0 Downvote
Send text msg was success, but how to read new incomming msg?
 
Upvote 0 Downvote
You have 2 opening and 2 closing brackets so from that perspective nothing is wrong.

If you just want a solution and use gdiplusx, I guess updating the version you use should fix the problem, which I assume is buried deep in some include file and/or declaration of the gdiplus function. And that's likely already noticed and fixed



If you're interested in what actually is compiled and is most likely really just missing a closing bracket look into the .err file of the build/compile, the simplest reason is the buggy line might not be the selected one and you're just looking in the wrong place.


Also, the .err file logs the actually compiled code (after precompiler options like #DEFINE are applied). To demonstrate this here is an example that looks innocent at first sight, just like your case:
innocent_pmker9.png


Looking into the .err file it's easy to see there really is a missing closing bracket:
[pre]? myalltrim((Strconv('test',5))
Error in line 3: Function name is missing ).[/pre]
Now it's apparent there are 3 openning and two closing brackets.

What's weird though is the compilrd code written into the .err file is not the same as the source code. And the answer to that is in a #Define that's somewhere up, not in sight:
Code: 
#Define alltrim myalltrim(
There an opening bracket is introduced. And it would cause any line containing ALLTRIM to have one additional opening bracket and thus missing a closing bracket.

Note what I'm saying is not that it's exactly that #DEFINE, not necessarily even a similar one, but something similar as this that's somewhere buried in all the files of gdiplusx. So the fastest fix is not tracking it down but just using the latest version that has this fixed, very likely. Unless it is the latest version but then the maintainers of the project will have a better chance tracking it down than you, as the involved header and source code files are much more than in my demonstration example.

All in all, that's how "dirty" VFPs precompiling is, you can do quite clever things with it but also introduce hard to track down problems that only become apparent if you don't just look, but really look closely. Especially if something isn't apparent from the source code alone, looking into error logs and the build .err file can give more details.

Chriss
 
Upvote 0 Downvote
Besides that, not to forget: The actual line number with an error might be some other line and it may not get this error by means of a mechanim of define turning a correct line into a buggy line.

And all that aside: I'm not even sure the question you have is related to the whatsapp thread at all, it would be good to start your own thread for your own question.

And welcome to the forum, that's really an interesting case for which you joined the forum, because on the surface it looks like a bug of VFP.
Chriss
 
Upvote 0 Downvote
Status
Not open for further replies.

Similar threads

Premal Vala
  • Question
VFP with MYSQL - mySQL server gone away
Replies
8
Views
564
Chris Miller
Chris Miller
sdocker
  • Locked
  • Question
Email automation with OUTLOOKNEW
Replies
10
Views
354
Mike Lewis
Mike Lewis
trial03
  • Question
can VFP interact with https://github.com/Nutlope/llama-ocr ?
Replies
2
Views
236
trial03
trial03
infinetecode
  • Question
VFP Report : Dynamics
Replies
4
Views
260
Chris Miller
Chris Miller
RTD78
  • Question
VFP Form Refresh
Replies
2
Views
261
RTD78
RTD78

Part and Inventory Search

Sponsor

Back
Top