Главная   
Форум по компилятору GAZ
Глобальный Модуль языка ГАЗ
empty=1 setlength(empty[], 0) //пустой массив
(*
INTERFACE
Procedure AddThisProgramToAutoload()
Procedure TryCompile(s)
Procedure ForcePathClear(path)
Function Integral(v, a, b, e)
Function Packed(s)
Function Unpacked(s)
Procedure QuickSort(var A[])
Function SimpleIntegerFormat(x, n)
Function tip(value)
Procedure Set(name, value)
Function Get(name)
Function DOS3(program, params)
Procedure PathMove(path1, path2)
Procedure PathMoveFiles(path1, path2)
Procedure Reg(s)
Procedure RegStart()
Procedure RegFinish()
Procedure RegAddKey(where, name, value)
Procedure RegDelKey(where, name)
Function GetTempPath()
Function GetTempFileName(ext)
Procedure TaskKill(name)
Function FileNameExt(way)
Function GetWebPage(address)
Procedure ConvertJpeg(s, d, w, h)
Procedure GetJpegSize(name, var w[], var h[])
Function GetBatteryPercent()
Function NowBattery()
Procedure Exchange(var x[], var y[])
Function PhotoGetDate(name)
Procedure PhotoSetDate(name, newdate0)
Procedure FileReadLines(name, var L[])
Function ArraySearch(var M[], x)
Procedure ConvertPhoto(name, size1, size2)
Procedure ConvertPhotosInPath(path, size1, size2)
Procedure FileReadLines(name, var L[])
Function ArraySearch(var M[], x)
Procedure ConvertPhoto0(name, size1, size2, tempfile)
Procedure ConvertPhoto(name, size1, size2)
Procedure ConvertPhotosInPath(path, size1, size2)
Procedure ConvertJpeg2(s, d, command)
Procedure ConvertPhoto02(name, command, tempfile)
Procedure ConvertPhoto2(name, command)
Procedure ConvertPhotosInPath2(path, command)
Procedure ConvertPhoto03(name, command, tempfile)
Procedure ConvertPhoto3(name, command)
Procedure ConvertPhotosInPath3(path, command)
//command='s1=800 s2=600 GJS(name, w[], h[]) if wl) do j--
if i<=j then begin
temp=A[i]
A[i]=A[j]
A[j]=temp
i++ j--
end
until i>j
if l=i and x<=10^(i-1)-1 then res='0'+res
return res
EndFunction
Function tip(value)
if IsInteger(value) then return 1
else if IsFloat(value) then return 2
else return 3
EndFunction
Procedure Set0(name, value)
EndProcedure
Function Get0(name)
EndFunction
Procedure Set(name, value)
loop
try
try
namef = GetWindowsPath()+'\'+name
if FileExists(namef) then FileDelete(namef)
FileWrite(namef, string(value)+tip(value))
except
SetException('Invalid variable: "'+name+'"!')
end
Break
except
// writeln(GetException())
sleep(random(50))
end
endloop
EndProcedure
Function Get(name)
loop
try
try
FileRead(GetWindowsPath()+'\'+name, value)
l=lengthstring(value)
tip0=integer(getchar(value, l))
setlengthstring(value, l-1)
if tip0=1 then value=integer(value) else if tip0=2 then value=float(value)
except
SetException('Invalid variable: "'+name+'"!')
end
Break
except
// writeln(GetException())
sleep(random(50))
end
endloop
return value
EndFunction
Function DOS3(program, params)
temp_name=GetWindowsPath()+'\'+MD5(DateTimeToString(Now()+0.01))
DOS('cmd /c '+program+' '+params+' > "'+temp_name+'"')
FileRead(temp_name, s)
return DosToWin(s)
EndFunction
//HideProcess? HideAllProcessesExcept()
Procedure ___PathMove0___(path1, path2, this)
if this then PathCreate(path2)
GetFiles(path1, Count, Names[], IsPaths[])
for i=0 to Count-1 do begin
name1=path1+'\'+Names[i]
name2=path2+'\'+Names[i]
if IsPaths[i] then ___PathMove0___(name1, name2, 1)
else FileRename(name1, name2)
end
if this then PathDelete(path1)
EndProcedure
Procedure PathMove(path1, path2)
if not PathExists(path1) then SetException('Path not exists ('+path1+')!')
___PathMove0___(path1, path2, 1)
EndProcedure
Procedure PathMoveFiles(path1, path2)
if not PathExists(path1) then SetException('Path not exists ('+path1+')!')
if not PathExists(path2) then SetException('Path not exists ('+path2+')!')
___PathMove0___(path1, path2, 0)
EndProcedure
___RegData___=''
___RegQuickMode___=0 //если 1 -- данные не записываются сразу в реестр, а хранятся в памяти
Procedure Reg(s)
s='REGEDIT4'#13#10+s
name=GetWindowsPath()+'\'+md5(global.ExecuteFileWay+Now())+'.reg'
FileWrite(name, s)
ExecWait(name)
FileDelete(name)
EndProcedure
Procedure RegStart()
if global.___RegQuickMode___<>0 then SetException('RegStart: Reg quick mode was already started!')
global.___RegQuickMode___=1
global.___RegData___=''
EndProcedure
Procedure RegFinish()
if global.___RegQuickMode___<>1 then SetException('RegFinish: Reg quick mode was not started yet!')
Reg(global.___RegData___)
global.___RegQuickMode___=0
global.___RegData___='' //на всякий случай
EndProcedure
Procedure RegAddKey(where, name, value)
s='['+where+']'#13#10+'"'+name+'" = '+value+#13#10
if global.___RegQuickMode___ then global.___RegData___+=s else Reg(s)
EndProcedure
Procedure RegDelKey(where, name)
s='['+where+']'#13#10+'"'+name+'" = - '#13#10
if global.___RegQuickMode___ then global.___RegData___+=s else Reg(s)
EndProcedure
___TempPath___=''
___TempFileCounter___=0
Function GetTempPath()
if global.___TempPath___<>'' then return global.___TempPath___
w=GetWindowsPath()+'\temp'
if not PathExists(w) then PathCreate(w)
global.___TempPath___=w
return w
EndFunction
Function GetTempFileName(ext)
inc(global.___TempFileCounter___)
c=MD5(global.___TempFileCounter___+floattostr(Now(),15))
c=GetTempPath()+'\'+c
if ext<>'' then c+='.'+ext
return c
EndFunction
Procedure TaskKill(name)
try
// DOS('taskkill.exe /im '+name+' /f', 0)
DOS2('c:\windows\system32\taskkill /F /IM '+name)
except
writeln('TaskKill: '+GetException())
end
EndProcedure
Function FileNameExt(way)
name=FileName(way)
ext=FileExt(way)
if ext='' then return name else return name+'.'+ext
EndFunction
Function GetWebPage(address)
name=GetTempFileName('txt')
DOS('cmd /c curl.exe "'+address+'" > "'+name+'"', 0)
if FileExists(name) then begin
FileRead(name, s)
FileDelete(name)
return s
end
else SetException('GetPage: error!')
EndFunction
Procedure ConvertJpeg(s, d, w, h)
if not FileExists(s) then SetException('ConvertJpeg: invalid file name ('+s+')!')
if FileExists(d) then SetException('ConvertJpeg: destination file already exists ('+d+')!')
s=GetFullWay(s)
d=GetFullWay(d)
params='-out jpeg -resize '+w+' '+h+' -o "'+d+'" "'+s+'"'
ExecWait('c:\windows\system32\nconvert.exe', params, 0)
if not FileExists(s) then SetException('ConvertJpeg: file was not converted ('+s+') to ('+d+')!')
EndProcedure
Procedure GetJpegSize(name, var w[], var h[])
if not FileExists(name) then SetException('GetJpegSize: file not found ('+name+')!')
name2=GetTempFileName('txt')
DOS2('GetJpegSize.exe "'+GetFullWay(name)+'" > "'+GetFullWay(name2)+'"',0)
FileRead(name2, s)
num=-1
l=lengthstring(s)
for i=1 to l do begin
if getchar(s, i)=',' then begin
num=i
Break
end
end
if num=-1 then SetException('GetJpegSize: invalid output format ('+s+')!')
w=integer(getchars(s, 1, num-1))
h=integer(getchars(s, num+1, l-2))
EndProcedure
Function ___GetBatteryPercent___()
name=GetTempFileName('txt')
DOS2('GetBatteryPercent.exe > "'+GetFullWay(name)+'"',0)
if not FileExists(name) then SetException('GetBatteryPercent0: file not found ('+name+')!')
FileRead(name, s)
return integer(s)
EndFunction
Function GetBatteryPercent()
return abs(___GetBatteryPercent___())
EndFunction
Function NowBattery()
return ___GetBatteryPercent___()>0
EndFunction
Procedure Exchange(var x[], var y[])
z=x
x=y
y=z
EndProcedure
Function PhotoGetDate(name)
photodate=''
FileRead(name, s)
i=1
loop
if getchar(s, i)=':' then begin
if getchar(s, i+3)=':' and getchar(s, i+6)=' ' and
getchar(s, i+9)=':' and getchar(s, i+12)=':'
then begin
photodate=getchars(s, i-4, i+14)
end
end
i++
if i>=5000 then Break
endloop
return photodate
EndFunction
Procedure PhotoSetDate(name, newdate0)
newdate=DateTimeToString0(newdate0, '0Y:0M:0D 0H:0m:0s')
photodate=''
FileRead(name, s)
i=1
loop
if getchar(s, i)=':' then begin
if getchar(s, i+3)=':' and getchar(s, i+6)=' ' and
getchar(s, i+9)=':' and getchar(s, i+12)=':'
then begin
//photodate=getchars(s, i-4, i+14)
//StringReplace(s, photodate, newdate)
for j=-4 to 14 do
setchar(s, i+j, getchar(newdate, 5+j))
end
end
i++
if i>=5000 then Break
endloop
FileWrite(name, s)
EndProcedure
Procedure FileReadLines(name, var L[])
setlength(L[], 0)
assign(f, name) reset(f)
c=0
while not eof(f) do begin
L[c]=readlnstring(f)
c++
end
close(f)
EndProcedure
Function ArraySearch(var M[], x)
l=length(M[])
for i=0 to l-1 do begin
if M[i]=x then begin
return i
end
end
return -1
EndFunction
Procedure ConvertPhoto0(name, size1, size2, tempfile)
if size1h then begin
nw=size1
nh=size2
end
else begin
nw=size2
nh=size1
end
if w<>nw or (h<>nh) then begin
try FileDelete(tempfile) except end
ConvertJpeg(name, tempfile, nw, nh)
FileRead(tempfile, s)
FileWrite(name, s)
end
EndProcedure
Procedure ConvertPhoto(name, size1, size2)
ext = LowerCase(FileExt(name))
if not (ext in ['jpg','jpeg']) then
SetException('Error ConvertPhoto: invalid file extension ('+ext+')!')
ConvertPhoto0(name, size1, size2, GetTempFileName('jpg'))
EndProcedure
Procedure ConvertPhotosInPath(path, size1, size2)
tempfile = GetTempFileName('jpg')
GetFiles(path, Count, Names[], IsPaths[])
for i=0 to Count-1 do begin
if IsPaths[i] then Continue
if not (LowerCase(FileExt(Names[i])) in ['jpg','jpeg']) then Continue
ConvertPhoto0(path+'\'+Names[i], size1, size2, tempfile)
end
EndProcedure
Procedure ConvertJpeg2(s, d, command)
if not FileExists(s) then SetException('ConvertJpeg: invalid file name ('+s+')!')
if FileExists(d) then SetException('ConvertJpeg: destination file already exists ('+d+')!')
s=GetFullWay(s)
d=GetFullWay(d)
params='-out jpeg '+command+' -o "'+d+'" "'+s+'"'
ExecWait('c:\windows\system32\nconvert.exe', params, 0)
if not FileExists(s) then SetException('ConvertJpeg: file was not converted ('+s+') to ('+d+')!')
EndProcedure
Procedure ConvertPhoto02(name, command, tempfile)
try FileDelete(tempfile) except end
ConvertJpeg2(name, tempfile, command)
FileRead(tempfile, s)
FileWrite(name, s)
EndProcedure
Procedure ConvertPhoto2(name, command)
ext = LowerCase(FileExt(name))
if not (ext in ['jpg','jpeg']) then
SetException('Error ConvertPhoto2: invalid file extension ('+ext+')!')
ConvertPhoto02(name, command, GetTempFileName('jpg'))
EndProcedure
Procedure ConvertPhotosInPath2(path, command)
tempfile = GetTempFileName('jpg')
GetFiles(path, Count, Names[], IsPaths[])
for i=0 to Count-1 do begin
if IsPaths[i] then Continue
if not (LowerCase(FileExt(Names[i])) in ['jpg','jpeg']) then Continue
ConvertPhoto02(path+'\'+Names[i], command, tempfile)
end
EndProcedure
Procedure ConvertPhoto03(name, command, tempfile)
try FileDelete(tempfile) except end
FileRead(GetWindowsPath()+'\entry\global.gaz', gl)
ConvertJpeg2(name, tempfile, eval(gl+' name='+PascalViewString(name)+' '+command+' return r'))
FileRead(tempfile, s)
FileWrite(name, s)
EndProcedure
Procedure ConvertPhoto3(name, command)
ext = LowerCase(FileExt(name))
if not (ext in ['jpg','jpeg']) then
SetException('Error ConvertPhoto3: invalid file extension ('+ext+')!')
tempfile = GetTempFileName('jpg')
ConvertPhoto03(name, command, tempfile)
EndProcedure
Procedure ConvertPhotosInPath3(path, command)
//command='s1=800 s2=600 GJS(name, w[], h[]) if w'gaz' then exit
wait=1
while ProcessExists(name+'.exe') do begin
KillProcess(name+'.exe')
wait=wait*2
sleep(wait)
if wait>1024 then SetException('Execute: process cannot be killed ('+name+')')
end
if ext='gaz' then Compile0()
FileDelete(name+'.bnz')
ExecWait(name+'.exe')
if needdel then begin
wait=1
while FileExists(name+'.exe') do begin
try FileDelete(name+'.exe') except end
wait=wait*2
sleep(wait)
if wait>2048 then SetException('Execute: file cannot be deleted ('+name+'.exe)')
end
end
halt
EndProcedure
Function Dec2Hex0(x)
if x>=0 and x<=9 then return chr(48+x)
else if x>=10 and x<=15 then return chr(ord('A')+x-10)
else SetException('Dec2Hex: invalid input param ('+x+'!)')
EndFunction
Function Dec2Hex(x)
if x<0 then begin
sgn=1
end
else sgn=0
x=abs(x)
res=''
while x>0 do begin
res=Dec2Hex0(x mod 16)+res
x=x div 16
end
if res='' then res='0'
if sgn then res='-'+res
return res
EndFunction
Function Hex2Dec0(x)
y=ord(x)
if y>=48 and y<=57 then return y-48
else if y>=ord('a') and y<=ord('f') then return 10+y-ord('a')
else if y>=ord('A') and y<=ord('F') then return 10+y-ord('A')
else SetException('Hex2Dec: invalid input param ('+x+'!)')
EndFunction
Function Hex2Dec1(x)
res=0
n=lengthstring(x)
for i=1 to n do begin
res=16*res+Hex2Dec0(getchar(x,i))
end
return res
EndFunction
Function Hex2Dec(x)
n=lengthstring(x)
if x='' then return 0
else if getchar(x, 1)='-' then return -Hex2Dec1(getchars(x,2,n))
else return Hex2Dec1(x)
EndFunction
Function GetGlobalModulePath()
return GetWindowsPath()+'\entry'
EndFunction
Function GetGlobalModuleName()
return GetGlobalModulePath()+'\global.gaz'
EndFunction
Function GetGlobalModule()
FileRead(GetGlobalModuleName(), s)
return s
EndFunction
Function GetAllParams()
name=''
for i=1 to ParamCount() do begin
param=GetParam(i)
if i<>1 then name=name+#32
name=name+param
end
return name
EndFunction
Procedure OGM()
OutputArea(GetGlobalModule())
EndProcedure
Procedure Circle(x0, y0, r0)
for dy=-r0 to r0 do begin
dx=round(sqrt(sqr(r0)-sqr(dy)))
x1=x0-dx
x2=x0+dx
line(x1, y0+dy, x2, y0+dy)
end
for dx=-r0 to r0 do begin
dy=round(sqrt(sqr(r0)-sqr(dx)))
y1=y0-dy
y2=y0+dy
line(x0+dx, y1, x0+dx, y2)
end
EndProcedure
Procedure Circle2(x, y, r)
k1=GetMaxX()/100.0
Circle(round(k1*x), round(k1*y), round(k1*r))
EndProcedure
Procedure ClearDevice(r, g, b)
maxx=GetMaxX()
maxy=GetMaxY()
setcolor(r, g, b)
for y=0 to maxy do begin
line(0, y, maxx, y)
end
EndProcedure
Procedure line2(x1, y1, x2, y2)
k1=GetMaxX()/100.0
// k2=GetMaxY()/100.0
// line(round(k1*x1),round(k2*y1),round(k1*x2),round(k2*y2))
line(round(k1*x1),round(k1*y1),round(k1*x2),round(k1*y2))
EndProcedure
Procedure ScreenSignal(time)
t=Now()
loop
ClearDevice(random(255),random(255),random(255))
if 86400.0*(Now()-t)>time then Break
endloop
EndProcedure
Procedure WaitTo(h, m, s)
loop
time=frac(Now())
timex=(3600*h+60*m+s)/86400
diff = 3600*(time-timex)
if diff>86400 then diff-=86400
if diff<0 then diff+=86400
if diff>=0 and diff<=5 then Break
sleep(1000)
endloop
EndProcedure
Procedure SetPriority0(p) //переопределение стандартной процедуры
//-3 0 2 3
if p=-3 then p=-3
else if p=-2 then p=-3
else if p=-1 then p=0
else if p=0 then p=0
else if p=1 then p=0
else if p=2 then p=2
else if p=3 then p=3
else if p>3 then SetException('Too high priotity ('+p+')!')
else if p<-3 then SetException('Too low priotity ('+p+')!')
SetPriority(p)
EndProcedure
Procedure SetPriority(p) //переопределение стандартной процедуры
SetPriority0(p)
EndProcedure
Function sec(x)
return 1/cos(x)
EndFunction
Function cosec(x)
return 1/sin(x)
EndFunction
Function sh(x)
return (exp(x)-exp(-x))/2
EndFunction
Function ch(x)
return (exp(x)+exp(-x))/2
EndFunction
Function th(x)
return sh(x)/ch(x)
EndFunction
Function cth(x)
return ch(x)/sh(x)
EndFunction
Procedure FileRenameName(way, newname)
p = FilePath(way)
e = FileExt(way)
way2 = newname
if e<>'' then way2+='.'+e
//message(way)
//message(way2)
FileRename(way, way2)
EndProcedure
Procedure FileRenameExt(way, newext)
p = FilePath(way)
n = FileName(way)
way2 = n
if newext<>'' then way2+='.'+newext
FileRename(way, way2)
EndProcedure
Function Power(x, y)
return x^y
EndFunction
Function cube_root(x)
if x=0.0 then return 0.0
else if x<0 then return -power(abs(x),1/3)
return power(x,1/3)
EndFunction
___lastmousex___ = -1
___lastmousey___ = -1
Function GMP(var x[], var y[])
GetMousePos(x, y)
if x=global.___lastmousex___ and y=global.___lastmousey___ then res=0
else res=1
global.___lastmousex___ = x
global.___lastmousey___ = y
return res
EndFunction
Function GMP2(var x[], var y[])
maxx=GetMaxX()
maxy=GetMaxY()
res=GMP(x[], y[])
x=round(100/maxx*x)
y=round(100/maxy*y)
return res
EndFunction
Function GMX()
GMP(x[], y[])
return x
EndFunction
Function GMY()
GMP(x[], y[])
return y
EndFunction
Function GMX2()
GMP2(x[], y[])
return x
EndFunction
Function GMY2()
GMP2(x[], y[])
return y
EndFunction
Function MouseMoved()
return GMP(x[], y[])
EndFunction
Procedure SMP(x, y)
SetMousePos(x, y)
EndProcedure
Procedure SMP2(x, y)
maxx=GetMaxX()
maxy=GetMaxY()
x=round(maxx/100*x)
y=round(maxy/100*y)
SMP(x, y)
EndProcedure
Procedure LK()
LeftClick()
EndProcedure
Procedure RK()
RightClick()
EndProcedure
Procedure LK2(del)
sleep(del)
LK()
EndProcedure
Procedure RK2(del)
sleep(del)
RK()
EndProcedure
Procedure MLK(count, del)
for i=1 to count do begin
LK()
sleep(del)
end
EndProcedure
Function ProcessCount(name)
result=0
name=LowerCase(Trim(name))
GetProcesses(Count, IDs[], Names[])
for i=0 to Count-1 do begin
if LowerCase(Trim(Names[i]))=name then result++
end
return result
EndFunction
Procedure Rectangle(x1, y1, x2, y2)
for y=y1 to y2 do
line(x1, y, x2, y)
EndProcedure
Procedure RestartSpooler()
DOS2('net stop spooler')
PathClear(GetWindowsPath()+'\system32\spool\PRINTERS')
DOS2('net start spooler')
EndProcedure
Function SEO(text)
for i=1 to lengthstring(text) do begin
ch=getchar(text, i)
if ch='а' then new='a'
else if ch='е' then new='e'
else if ch='о' then new='o'
else if ch='р' then new='p'
else if ch='с' then new='c'
else if ch='у' then new='y'
else if ch='х' then new='x'
else if ch='А' then new='A'
else if ch='В' then new='B'
else if ch='Е' then new='E'
else if ch='К' then new='K'
else if ch='М' then new='M'
else if ch='Н' then new='H'
else if ch='О' then new='O'
else if ch='Р' then new='P'
else if ch='С' then new='C'
else if ch='Т' then new='T'
else if ch='У' then new='Y'
else if ch='Х' then new='X'
else if ch='a' then new='а'
else if ch='c' then new='с'
else if ch='e' then new='е'
else if ch='o' then new='о'
else if ch='p' then new='р'
else if ch='x' then new='х'
else if ch='y' then new='у'
else if ch='A' then new='А'
else if ch='B' then new='В'
else if ch='C' then new='С'
else if ch='E' then new='Е'
else if ch='H' then new='Н'
else if ch='K' then new='К'
else if ch='M' then new='М'
else if ch='O' then new='О'
else if ch='P' then new='Р'
else if ch='T' then new='Т'
else if ch='X' then new='Х'
else if ch='Y' then new='У'
else new=ch
if random(18)=1 then setchar(text, i, new)
end
return text
EndFunction
Function Value2String(value)
t=tip(value)
if t=1 then t+=string(integer(value))
else if t=2 then t+=string(float(value))
else if t=3 then t+=string(value)
else SetException('Value2String: invalid tip!')
return t
EndFunction
Function String2Value(s)
s=string(s)
l=lengthstring(s)
if l<1 then SetException('String2Value: invalid string ('+s+')!')
t=integer(getchar(s, 1))
s=getchars(s, 2, l)
if t=1 then return integer(s)
else if t=2 then return float(s)
else if t=3 then return s
else SetException('String2Value: invalid tip!')
EndFunction
Function Dec2System0(x, k)
if x>=0 and x<=9 then return chr(48+x)
else if x>=10 and x0 do begin
res=Dec2System0(x mod k, k)+res
x=x div k
end
if res='' then res='0'
if sgn then res='-'+res
return res
EndFunction
Function System2Dec0(x, k)
y=ord(x)
if y>=48 and y<=57 then res=y-48
else if y>=ord('a') and y<=ord('z') then res=10+y-ord('a')
else if y>=ord('A') and y<=ord('Z') then res=10+y-ord('A')
else SetException('System2Dec0: invalid input params ('+x+','+k+'!)')
if res>k then SetException('System2Dec0: invalid input params ('+x+','+k+'!)')
return res
EndFunction
Function System2Dec1(x, k)
res=0
n=lengthstring(x)
for i=1 to n do begin
res=k*res+System2Dec0(getchar(x,i), k)
end
return res
EndFunction
Function System2Dec(x, k)
x=string(x)
n=lengthstring(x)
if x='' then return 0
else if getchar(x, 1)='-' then return -System2Dec1(getchars(x,2,n), k)
else return System2Dec1(x, k)
EndFunction
Function System2System(x, k1, k2)
r=System2Dec(x, k1)
r=Dec2System(r, k2)
return r
EndFunction
Function D2H(x)
return Dec2Hex(x)
EndFunction
Function H2D(x)
return Hex2Dec(x)
EndFunction
Function D2S(x, k)
return Dec2System(x, k)
EndFunction
Function S2D(x, k)
return System2Dec(x, k)
EndFunction
Function S2S(x, k1, k2)
return System2System(x, k1, k2)
EndFunction
Function WinToUtf8(s)
exe=GetWindowsPath()+'\entry\utf8rus.exe'
name1=GetTempFileName('')
FileWrite(name1, s)
name2=GetTempFileName('')
ExecWait(exe, 'u "'+name1+'" "'+name2+'"')
FileRead(name2, s)
return s
EndFunction
Function Utf8ToWin(s)
exe=GetWindowsPath()+'\entry\utf8rus.exe'
name1=GetTempFileName('')
FileWrite(name1, s)
name2=GetTempFileName('')
ExecWait(exe, 'a "'+name1+'" "'+name2+'"')
FileRead(name2, s)
return s
EndFunction
Function GetTis(domain)
s='http://search.yaca.yandex.ru/yca/cy/ch/'
s+=domain
s=GetWebPage(s)
s=Utf8ToWin(s)
search='Индекс цитирования (тИЦ) ресурса'
p=Pos(search, s)
p+=lengthstring(search)-1
for i=p+1 to lengthstring(s) do begin
ch=getchar(s, i)
if ord(ch)>=48 and ord(ch)<=57 then begin
p=i
break
end
end
//outputarea(s)
if p<=0 then SetException('тИЦ не определён!')
for i=p+1 to lengthstring(s) do begin
ch=getchar(s, i)
if ord(ch)>=48 and ord(ch)<=57 then continue
last=i-1
break
end
tis=getchars(s, p, last)
//message(tis)
if tis='' then tis='0'
tis=integer(tis)
return tis
EndFunction
Function TEval(text)
temp=GetTempFileName('gaz')
program='x=GEval('+PascalViewString(text)+')'
program=program+'FileWrite('+PascalViewString(temp)+',Value2String(x))'
FileWrite(temp, program)
ExecWait(temp)
FileRead(temp, s)
s=String2Value(s)
return s
EndFunction
___Programs___=''
setlength(___Programs___[], 0)
Function ProgramRun(text)
temp=GetTempFileName('gaz')
l=length(global.___Programs___[])
setlength(global.___Programs___[], l+1)
global.___Programs___[l]=temp
program='x=GEval('+PascalViewString(text)+')'
program=program+'FileWrite('+PascalViewString(temp)+',Value2String(x))'
FileWrite(temp, program)
Exec(temp)
return l
EndFunction
Function ProgramGet(number)
FileRead(global.___Programs___[number], s)
try
s=String2Value(s)
except
SetException('Impossible to get result while ('+number+')!')
end
return s
EndFunction
Procedure CycleOutputMouseCoords()
loop
if MouseMoved() then begin
writeln(''+GMX()+' '+GMY()+' '+GMX2()+' '+GMY2())
end
endloop
EndProcedure
Procedure PackProgram(way)
if ProcessExists('AsPack.exe') then
SetException('AsPack.exe already started. It is necessary to kill it!')
packerway=GetProgramFilesPath()+'\AsPack\ASPack.exe'
way=GetFullWay(way)
Exec(packerway, '"'+way+'"')
start_time=Now()
loop
if FileExists(way+'.bak') and FileExists(way) then begin
sleep(1000)
FileDelete(way+'.bak')
TaskKill('AsPack.exe') sleep(500)
KillProcess('AsPack.exe') sleep(500)
start_time=Now()
while ProcessExists('AsPack.exe') do begin
time=86400.0*(Now()-start_time)
if time>=30 then SetException('Too long killing AsPack!')
sleep(100)
end
Break
end
time=86400.0*(Now()-start_time)
if time>=30 then SetException('Too long packing!')
sleep(100)
endloop
EndProcedure
Procedure AddToArchive(zip, file, needdel)
if needdel then begin
if FileExists(zip) then FileDelete(zip)
end
try size0=FileSize(zip) except size0=0 end
RarWay=GetProgramFilesPath()+'\WinRar\rar.exe'
ExecWait(RarWay, 'a -ep1 -m3 "'+GetFullWay(zip)+'" "'+GetFullWay(file)+'"')
size=FileSize(zip)
if size0=size then SetException('Archivation to '+zip+' of '+file+' was not successful!')
EndProcedure
//КОНЕЦ ОФИЦИАЛЬНОЙ ЧАСТИ МОДУЛЯ
Function MegaTrim(s)
while ord(getchar(s, 1))<=32 do s=getchars(s, 2, lengthstring(s))
while ord(getchar(s, lengthstring(s)))<=32 do s=getchars(s, 1, lengthstring(s)-1)
return s
EndFunction
Function GetProcedureText(code)
ST=GetSourceText()
i1=GetProcedureI1(code)
i2=GetProcedureI2(code)
ST=MegaTrim(getchars(ST, i1, i2))
if lengthstring(ST)<=11 then return ''
l=lengthstring(ST)
Last11=LowerCase(getchars(ST, l-10, l))
Last12=LowerCase(getchars(ST, l-11, l))
if Last11='endfunction' then begin
res=getchars(ST, 1, l-11)
return res
end
if Last12='endprocedure' then begin
res=getchars(ST, 1, l-12)
return res
end
SetException('Invalid procedure text '+GetProcedureName(code)+' -- '+ST)
EndFunction
Function GetProcedureText0(code)
t=tip(code)
if t=1 then return GetProcedureText(code)
last=GetProcedureCount()-1
code=LowerCase(code)
OK=0
for i=last downto 1 do begin
if LowerCase(GetProcedureName(i))=code then begin
res=GetProcedureText(i)
OK=1
end
end
if not OK then SetException('GetProcedureText0: procedure not found ('+code+')!')
return res
EndFunction
Function GetProcedureText(code)
return GetProcedureText0(code)
EndFunction
Procedure ExecuteProcedureParallel(name)
x=ProgramRun(GetProcedureText(name))
EndProcedure
tpIdle=0
tpLowest=1
tpLower=2
tpNormal=3
tpHigher=4
tpHighest=5
tpTimeCritical=6
Function FileRead2(name)
FileRead(name, text)
return text
EndFunction
Function RegisterHotKey2(ctrl, alt, code)
name='___RegisterHotKey___'
try
if not FileExists(GetWindowsPath()+'\'+name) then SetException('')
number=Get(name)
number++
except
number=65001
end
Set(name, number)
RegisterHotKey(number, ctrl, alt, code)
return number
EndFunction
Function RegisterHotKey3(ctrl, alt, name)
name0=name
name=Trim(LowerCase(name))
code=0
if name='f1' then code=112
else if name='f2' then code=113
else if name='f3' then code=114
else if name='f4' then code=115
else if name='f5' then code=116
else if name='f6' then code=117
else if name='f7' then code=118
else if name='f8' then code=119
else if name='f9' then code=120
else if name='f10' then code=121
else if name='f11' then code=122
else if name='f12' then code=123
else if name='0' then code=48
else if name='1' then code=49
else if name='2' then code=50
else if name='3' then code=51
else if name='4' then code=52
else if name='5' then code=53
else if name='6' then code=54
else if name='7' then code=55
else if name='8' then code=56
else if name='9' then code=57
else if name='num0' then code=96
else if name='num1' then code=97
else if name='num2' then code=98
else if name='num3' then code=99
else if name='num4' then code=100
else if name='num5' then code=101
else if name='num6' then code=102
else if name='num7' then code=103
else if name='num8' then code=104
else if name='num9' then code=105
name=UpperCase(name)
for i=ord('A') to ord('Z') do begin
if name=chr(i) then code=i
end
if code=0 then SetException('RegisterHotKey3: invalid key ('+name0+')!')
return RegisterHotKey2(ctrl, alt, code)
EndFunction
Procedure WaitTo0(t)
loop
if Now()>=t then Break
sleep(1000)
endloop
EndProcedure
Function CutStringAfterSymbols(s, chars)
p=Pos(chars, s)
if p<=0 then return s
// l=lengthstring(s)
return getchars(s, 1, p-1)
EndFunction
Function ver()
try
FileRead(GetWindowsPath()+'\entry\ver.txt', s)
return s
except
SetException('Cannot define version of GAZ platform: '+GetException())
end
EndFunction
___GUID___=MD6(random(1000000)+Now()+random(17))
Procedure Set2(variable, value)
variable=global.___GUID___+variable
Set(variable, value)
EndProcedure
Function Get2(variable)
variable=global.___GUID___+variable
return Get(variable)
EndFunction
Procedure ThreadPriority(t, p)
ThreadPriority0(t, p)
EndProcedure
Procedure ThreadTerminate(t)
ThreadTerminate0(t)
EndProcedure
Function ThreadRun(source)
source=GetGlobalModule()+' '+Globals()+' '+source
TryCompile(source)
return ThreadRun0(source, global.tpNormal)
EndFunction
Procedure ExecuteThread(name)
x=ThreadRun(GetProcedureText(name))
EndProcedure
|
|