Главная   
Форум по компилятору 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





Rambler's Top100 HotLog