home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 8 Other / 08-Other.zip / wrp2mrln.zip / WRP2MRLN.PAS < prev    next >
Pascal/Delphi Source File  |  1996-08-28  |  11KB  |  332 lines
  1. program WRP2MRLN;
  2.  
  3. uses dos, os2def, os2base, Use32, crt;
  4. var
  5. cont,x,y,xy,yy : integer;
  6. rc,ver: word;
  7. chivo,archivo : array [1..8] of pChar;
  8. ch, archivoStr : array [1..8] of string;
  9. Backstr,CC,UNZ,RSP,RSR,Trash,bmp,dll,dat,rc2,res,nul:string;
  10. Back : pChar;
  11.  
  12. procedure print(col,row:integer; mens:string);
  13. begin
  14.         gotoxy(col,row);
  15.         write(mens);
  16. end;
  17.  
  18. function met(xy:integer):string;
  19. begin
  20.   if xy < 0 then begin;
  21.         print(16,19,'█');
  22.         print(16,20,'█');
  23.   end;
  24.   x := (16 + (0 * xy));
  25.   y := (16 + (6 * (1 + xy)));
  26.   textcolor(White);
  27.   print(14,18,'█▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀█');textcolor(black);print(67,18,'▄');textcolor(white);
  28.   print(14,19,'█');                                   print(66,19,'█');textcolor(black);print(67,19,'█');textcolor(white);
  29.   print(14,20,'█');                                   print(66,20,'█');textcolor(black);print(67,20,'█');textcolor(white);
  30.   print(14,21,'█ 00──────────25──────────50─────────75─────────100 █');textcolor(black);print(67,21,'█');textcolor(white);
  31.   print(14,22,'█▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄█');textcolor(black);print(67,22,'█');textcolor(black);
  32.   print(14,23,' ▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀');
  33.   textcolor(yellow);
  34.   while x < y do
  35.     begin
  36.         print(x,19,'█');
  37.         print(x,20,'█');
  38.         x:= x+1;
  39.     end;
  40. end;
  41.  
  42. procedure limpia;
  43. begin
  44.   x := 16;
  45.   while x < 66 do
  46.     begin
  47.         print(x,19,' ');
  48.         print(x,20,' ');
  49.         x:= x+1;
  50.     end;
  51. end;
  52.  
  53. procedure error1;
  54. begin
  55.         textcolor(green);
  56.         print(10,25,'No se puede respaldar el archivo '+ archivostr[cont]);
  57.         textcolor(yellow);
  58. end;
  59.  
  60. procedure respalda;
  61. begin
  62.         textcolor(yellow);
  63.         print(14,17,'Preparando archivos...');
  64.         Exec(GETENV('COMSPEC'), cc + ' UNPACK BUNDLE ' + nul);
  65.         MkDir(backStr);
  66.         print(09,15,'Los Archivos de respaldo seran guardados en '+ backstr);
  67.         print(14,17,'Respaldando el archivo');
  68.         cont := 1;
  69.         while cont <= 8 do
  70.              begin
  71.              print(37,17,archivoStr[cont]);
  72.              rc := doscopy (archivo[cont], BACK,0);
  73.              yy := -1;
  74.              met(yy + cont);
  75.              if rc <> 0 then
  76.                   begin
  77.                   error1;
  78.              end;
  79.              cont := cont + 1
  80.         end;
  81. end;
  82.  
  83. procedure cambia;
  84. var
  85. dir:String ;
  86.  
  87. begin
  88.    textcolor(yellow);
  89.    getdir(0,dir);
  90.    print(09,15,'Los archivos a modificar seran copiados temporalmente:       ');
  91.    print(14,16,DIR);
  92.    print(14,17,'Modificando archivo');
  93.    cont := 1;
  94.    while cont <= 8 do
  95.         begin
  96.         print(36,17,archivoStr[cont]);
  97.         yy := -2;
  98.         met (yy + cont);
  99.         rc := doscopy (archivo[cont],'.',0);
  100.         if rc <> 0 then
  101.                 begin
  102.                 error1;
  103.         end;
  104.         Exec(GETENV('COMSPEC'), cc + unz + ch[cont] + dat + nul);
  105.         Exec(GETENV('COMSPEC'), cc + rsp + ch[cont] + rc2 + nul + ' && ' + rsr + ch[cont] + dll + ch[cont] + res + nul);
  106.         Exec(GETENV('COMSPEC'), cc + Trash );
  107.         if cont = 3 then
  108.            begin
  109.            Exec(GETENV('COMSPEC'), cc + bmp );
  110.         end;
  111.         yy := -1;
  112.         met (yy + cont);
  113.         cont := cont + 1
  114.     end;
  115. end;
  116.  
  117.  
  118. procedure reemplaza;
  119. begin
  120.         print(09,15,'    Los archivos viejos seran reemplzados por los nuevos.      ');
  121.         cont := 1;
  122.         while cont <= 8 do
  123.            begin
  124.            yy := -2;
  125.            met(yy + cont);
  126.            print(14,17,'Remplazando...'+archivostr[cont]+'                      ');
  127.            GOTOXY(1,25);
  128.            Exec(GETENV('COMSPEC'),cc +' UNLOCK '+ archivostr[cont] + nul);
  129.            dosdelete(archivo[cont]);
  130.            dosmove(chivo[cont],archivo[cont]);
  131.            yy := -1;
  132.            met (yy + cont);
  133.            cont := cont + 1
  134.         end;
  135. end;
  136.  
  137. procedure comprime;
  138. begin
  139.         print(09,15,'    Los archivos viejos seran comprimidos.                  ');
  140.         cont := 1;
  141.         while cont <= 8 do
  142.            begin
  143.            yy := -2;
  144.            met(yy + cont);
  145.            print(14,17,'Comprimiendo...'+Archivostr[cont]+'                      ');
  146.            GOTOXY(1,25);
  147.            Exec(GETENV('COMSPEC'), cc +' lxlite '+ archivostr[cont] + nul);
  148.            yy := -1;
  149.            met (yy + cont);
  150.            cont := cont + 1
  151.         end;
  152. end;
  153.  
  154. procedure marco;
  155. begin
  156.   x := 1;
  157.   while x < 81 do  {Imprime los lados del marco}
  158.     begin
  159.         print(x,01,'█');
  160.         print(x,24,'█');
  161.         x:= x+1;
  162.     end;
  163.   y := 1;
  164.   while y < 24 do  {Imprime las lineas de arriba y abajo del marco}
  165.     begin
  166.         print(01,y,'█');
  167.         print(80,y,'█');
  168.         y:= y+1;
  169.     end;
  170. end;
  171. procedure Warp;
  172.   begin
  173.   textcolor(lightgray);
  174.   clrscr;
  175.   marco;
  176.   textcolor(white);
  177.   y := 4;
  178.   while y < 10 do  {Imprime las lineas de arriba y abajo del marco}
  179.     begin
  180.         print(12,y,'█');
  181.         print(69,y,'█');
  182.         y:= y+1;
  183.     end;
  184.   x := 12;
  185.   while x < 70 do  {Imprime los lados del marco}
  186.     begin
  187.         print(x,04,'▄');
  188.         print(x,10,'▀');
  189.         x:= x+1;
  190.     end;
  191.   textcolor(lightblue);
  192.   textbackground(Black);
  193.   print(13,05,'  ▄▄▄▄   ▄▄▄▄      ▄ ▄▄▄▄▄   ');
  194.   print(13,06,' █    █ █    ▀    █  ▀    █  ');
  195.   print(13,07,' █    █  ▀▀▀▀▄   █     ▄█▀   ');
  196.   print(13,08,' █    █ ▄    █  █    ▄█▀     ');
  197.   print(13,09,'  ▀▀▀▀   ▀▀▀▀  ▀     ▀▀▀▀▀▀  ');
  198.   textcolor(lightred);
  199.   print(41,05,' ▄     ▄  ▄▄▄▄  ▄▄▄▄  ▄▄▄▄  ');
  200.   print(41,06,' █     █ █    █ █   █ █   █ ');
  201.   print(41,07,' ▀█   █▀ █▀▀▀▀█ █▀█▀  █▀▀▀  ');
  202.   print(41,08,'  █ █ █  █    █ █  █  █     ');
  203.   print(41,09,'   ▀ ▀   ▀    ▀ ▀   ▀ ▀     ');
  204.   textcolor(yellow);
  205.   textbackground(blue);
  206.  
  207. end;
  208.  
  209.  
  210. begin
  211.  
  212. {Cadenas para los mensajitos y las lineas de comandos.}
  213.  
  214.   dll  := '.DLL ';
  215.   dat  := '.DAT ';
  216.   rc2  := '.RC2 ';
  217.   res  := '.RES ';
  218.   nul  := ' > NUL ';
  219.   ch[1] := ' PMVIOP';
  220.   ch[2] := ' PMWP';
  221.   ch[3] := ' PMMERGE';
  222.   ch[4] := ' PMCTLS';
  223.   ch[5] := ' IBMDEV32';
  224.   ch[6] := ' WPCONFIG';
  225.   ch[7] := ' WPPRTMRI';
  226.   ch[8] := ' DSPRES';
  227.   backStr := '\OS2\DLL\BACKUP';
  228.   archivoStr[1] := '\OS2\DLL\PMVIOP.DLL  ';
  229.   archivoStr[2] := '\OS2\DLL\PMWP.DLL    ';
  230.   archivoStr[3] := '\OS2\DLL\PMMERGE.DLL ';
  231.   archivoStr[4] := '\OS2\DLL\PMCTLS.DLL  ';
  232.   archivoStr[5] := '\OS2\DLL\IBMDEV32.DLL';
  233.   archivoStr[6] := '\OS2\DLL\WPCONFIG.DLL';
  234.   archivoStr[7] := '\OS2\DLL\WPPRTMRI.DLL';
  235.   archivoStr[8] := '\OS2\DLL\DSPRES.DLL  ';
  236.   CC      := ' /C ';
  237.   RSP     := ' RC -R ';
  238.   RSR     := ' RESMGR -A ';
  239.   UNZ     := ' UNZIP -o ';
  240.   bmp     := ' DEL *.BMP /F > NUL';
  241.   Trash   := ' DEL RES*.* /F > NUL && DEL *.RES /F > NUL && DEL *.RC2 /F > NUL ';
  242.  
  243. {Cadenas para las llamadas a OS/2.}
  244.  
  245.   back    := '\OS2\DLL\BACKUP';
  246.   chivo[1] := 'PMVIOP.DLL';
  247.   chivo[2] := 'PMWP.DLL';
  248.   chivo[3] := 'PMMERGE.DLL';
  249.   chivo[4] := 'PMCTLS.DLL';
  250.   chivo[5] := 'IBMDEV32.DLL';
  251.   chivo[6] := 'WPCONFIG.DLL';
  252.   chivo[7] := 'WPPRTMRI.DLL';
  253.   chivo[8] := 'DSPRES.DLL';
  254.   archivo[1] := '\OS2\DLL\PMVIOP.DLL';
  255.   archivo[2] := '\OS2\DLL\PMWP.DLL';
  256.   archivo[3] := '\OS2\DLL\PMMERGE.DLL';
  257.   archivo[4] := '\OS2\DLL\PMCTLS.DLL';
  258.   archivo[5] := '\OS2\DLL\IBMDEV32.DLL';
  259.   archivo[6] := '\OS2\DLL\WPCONFIG.DLL';
  260.   archivo[7] := '\OS2\DLL\WPPRTMRI.DLL';
  261.   archivo[8] := '\OS2\DLL\DSPRES.DLL';
  262.  
  263. {Aqui inicia el programa principal}
  264.  
  265.   viosetansi(1,0);
  266.   textcolor(lightgray);
  267.   textbackground(blue);
  268.   ClrScr;
  269.   marco;
  270.   textcolor(yellow);
  271.   print(27,7,'Este NO es un programa de:');
  272.   textcolor(lightblue);
  273.   print(17,09,'▀▀▀▀▀▀▀▀   ▀▀▀▀▀▀▀▀▀▀     ▀▀▀▀▀▀       ▀▀▀▀▀▀');
  274.   print(17,10,'▀▀▀▀▀▀▀▀   ▀▀▀▀▀▀▀▀▀▀▀▀   ▀▀▀▀▀▀▀     ▀▀▀▀▀▀▀');
  275.   print(17,11,'  ▀▀▀▀      ▀▀▀▀   ▀▀▀▀    ▀▀▀▀▀▀▀   ▀▀▀▀▀▀▀ ');
  276.   print(17,12,'  ▀▀▀▀      ▀▀▀▀▀▀▀▀▀▀     ▀▀▀▀▀▀▀▀ ▀▀▀▀▀▀▀▀ ');
  277.   print(17,13,'  ▀▀▀▀      ▀▀▀▀▀▀▀▀▀▀     ▀▀▀▀ ▀▀▀▀▀▀▀ ▀▀▀▀ ');
  278.   print(17,14,'  ▀▀▀▀      ▀▀▀▀   ▀▀▀▀    ▀▀▀▀  ▀▀▀▀▀  ▀▀▀▀ ');
  279.   print(17,15,'▀▀▀▀▀▀▀▀   ▀▀▀▀▀▀▀▀▀▀▀▀   ▀▀▀▀▀   ▀▀▀   ▀▀▀▀▀');
  280.   print(17,16,'▀▀▀▀▀▀▀▀   ▀▀▀▀▀▀▀▀▀▀     ▀▀▀▀▀    ▀    ▀▀▀▀▀');
  281.   ver := dosversion;
  282.   gotoxy(22,17);
  283.   writeln('     para OS/2 versión ', Lo(Ver) div 10, '.', Hi(Ver));
  284.   textcolor(yellow);
  285.   print(6,19,'Este programa *NO* esta sujeto a ninguna restricción de Copyright');
  286.   print(3,20,'salvo que no se borre, ni modifique mi nombre como autor original del mismo.');
  287.   print(20,25,'Presione cualquier Tecla para Continuar.');
  288.   repeat if readkey = #0 then readkey; until not keypressed;
  289.   print(20,25,'                                        ');
  290.   textcolor(lightgray);
  291.   clrscr;
  292.   marco;
  293.   textcolor(lightred);
  294.   print(07,03,'   AVISO: Este programa modificará archivos (DLL) del sistema.');
  295.   textcolor(yellow);
  296.   print(07,04,'  Para reemplazar Iconos, Punteros, Botones de control, usando el');
  297.   print(07,05,'manejador de recursos  (RESMGR.CMD, RDC.CMD, RDCPP.EXE) hecho por');
  298.   print(07,06,'Martin Lafaix y  (UNLOCK.EXE, LXLITE.EXE) de Andrew Zabolotny con');
  299.   print(07,07,'ayuda de FRIENDS  Software, (UNZIP.EXE) de Info-Zip, (UNPACK.EXE,');
  300.   print(07,08,'RC.EXE) de IBM Corp.  de los cuales algunos ya vienen incluidos. ');
  301.   print(07,10,'Sientáse libre de distribuir este programa,  modificarlo pero sín');
  302.   print(07,11,'cobrar por él  ó cambiar, Borrar mi Nombre como Autor Original de');
  303.   print(07,12,'este programa, La idea y  el Icono del Escritorio fue de parte de');
  304.   print(07,13,'Alfonso Pesqueira R.(apocalps@teesa.com) la extracción re-edición');
  305.   print(07,14,'de iconos y creación de este programa fue de parte de su servidor');
  306.   print(07,15,'Marcos Francisco Caselin N. (salesman@m-net.arbornet.org) ah, por');
  307.   print(07,16,'cierto, este es mi primer programa para OS/2 Woohoo!! =)');
  308.   print(07,17,'Aclaro,  No me hago responsable de los daños que pueda causar por');
  309.   print(07,18,'el mal manejo de este programa, se distribuye como es y tal cual.');
  310.   print(07,20,'Se aceptan sugerencias y comentarios, iconos y donaciones =) ');
  311.   print(07,21,'Todo sea por el Mejor Sistema Operativo Para PCs: OS/2');
  312.   print(20,25,'Presione cualquier Tecla para Continuar.');
  313.   repeat if readkey = #0 then readkey; until not keypressed;
  314.   warp;
  315.   print(20,25,'Presione cualquier Tecla para Continuar.');
  316.   repeat if readkey = #0 then readkey; until not keypressed;
  317.   print(20,25,'                                        ');
  318.   respalda;
  319.   print(14,17,'                                                       ');
  320.   limpia;
  321.   cambia;
  322.   limpia;
  323.   reemplaza;
  324.   Exec(GETENV('COMSPEC'), cc + ' DEL *'+ dat + nul);
  325.   limpia;
  326.   comprime;
  327.   clrscr;
  328.   print(19,13,'Todo ha Transcurrido Sin Ningún Problema');
  329.   print(21,14,  'Ahora ya Puede Reiniciar el Sistema.');
  330.   gotoxy(1,25);
  331. end.
  332.