Codigo sin utilidad

[Khronos]

En cuanto a la carpeta con poner:

Código Delphi [-]
If directoryExists('F:\autorun.inf')=true then begin
    RemoveDir('F:\autorun.inf');
end;

EDITO: cHackAll probé la entrada del registro que me dijistes y nada, le cambié el valor, reinicié y al hacer doble click sobre el icono de la memoria flash seguia ejecutandose el programa . Probado en Windows XP Home Edition.

[[cHackAll]]

Empezado por Khronos

...Voy a probar la entrada del registro y os digo

Me temo que la idea no es refutar los N métodos que personas NO mal intencionadas difunden en la gran telaraña para protejer a los indefensos usuarios; la idea creo que no va por ese lado.

Saludos NO virulosos

[[cHackAll]]

He aquí una Joke que hice para un amigo (claro que le quite la parte "peligrosa"), la historia comenzó cuando le comenzaron a apodar "Calamardo" (personaje de Bob Esponja ), por la forma en que envolvía a su pareja con sus peligrosos tentáculos y se me ocurrió recordarle dicho acontesimiento por un tiempo. Como es de suponerse decidí no subestimarlo e inyecté un "sonidito" a un proceso crítico para que no pueda hacer "stop" .

Como está de moda esto de inyección de códigos les adjunto dicho código sin utilidad .

Saludos

[[cHackAll]]

Código Delphi [-]
uses Windows, Messages, MMSystem, Types; // by cHackAll

var
 Buffer: array [0..31] of Byte;
 hWnd, hCanvas, hBrush, hWhite, hGray: Cardinal;
 WaveInHdr: TWaveHdr = (lpData: @Buffer; dwBufferLength: SizeOf(Buffer));

function WndProc(hWnd, Msg, wParam, lParam: Integer): Integer; stdcall;
var PaintStruct: TPaintStruct;
begin
 Result := 0;
 case Msg of
  WM_ERASEBKGND: Result := 1;
  WM_PAINT: begin
             BeginPaint(hWnd, PaintStruct);
             BitBlt(PaintStruct.hdc, 0, 0, SizeOf(Buffer) * 3, $FF, hCanvas, 0, 0, SRCCOPY);
             EndPaint(hWnd, PaintStruct);
            end;
  WM_DESTROY: PostQuitMessage(0);
 else
  Result := DefWindowProc(hWnd, Msg, wParam, lParam);
 end
end;

procedure waveInProc(waveIn, uMsg, dwInstance, lParam, wParam: Cardinal); stdcall;
begin
 if uMsg = WIM_DATA then
  begin
   waveInAddBuffer(waveIn, PWaveHdr(lParam), SizeOf(TWaveHdr));
   FillRect(hCanvas, Rect(0, 0, SizeOf(Buffer) * 3, $FF), hBrush);
   SelectObject(hCanvas, hGray);
   waveIn := SizeOf(Buffer);
   repeat Dec(waveIn);
    if Abs(Buffer[waveIn] - 128) = 1 then Buffer[waveIn] := 128;
    MoveToEx(hCanvas, waveIn * 3, 0, nil);
    LineTo(hCanvas, waveIn * 3, $FF);
   until waveIn = 0;
   SelectObject(hCanvas, hWhite);
   waveIn := High(Buffer);
   MoveToEx(hCanvas, waveIn * 3, Buffer[waveIn], nil);
   repeat Dec(waveIn);
    LineTo(hCanvas, waveIn * 3, Buffer[waveIn]);
   until waveIn = 0;
   repeat
    if Abs(Buffer[waveIn] - 128) > 1 then
     begin
      MoveToEx(hCanvas, waveIn * 3, 128, nil);
      LineTo(hCanvas, waveIn * 3, Buffer[waveIn]);
     end;
    Inc(waveIn);
   until waveIn = SizeOf(Buffer);
   InvalidateRect(hWnd, nil, True);
  end;
end;

var
 hScreen, waveIn: Cardinal;
 WndClass: TWndClass = (lpfnWndProc: @WndProc; cbWndExtra: 4; lpszClassName: 'Waves');

 Rect: TRect;
 Value: Cardinal = 0;
 Controls: array [0..1] of TMixerControl;
 MixerLine: TMixerLine = (cbStruct: SizeOf(TMixerLine); dwDestination: 1; dwComponentType: MIXERLINE_COMPONENTTYPE_DST_WAVEIN);
 LineControls: tMixerLineControls = (cbStruct: SizeOf(TMixerLineControls); dwControlType: MIXERCONTROL_CONTROLTYPE_VOLUME; cbmxctrl: SizeOf(TMixerControl); pamxctrl: @Controls);
 Details: TMixerControlDetails = (cbStruct: SizeOf(TMixerControlDetails); cChannels: 1; cbDetails: SizeOf(Value); paDetails: @Value);
 FormatEx: TWaveFormatEx = (wFormatTag: WAVE_FORMAT_PCM; nChannels: 2; nSamplesPerSec: 100; nAvgBytesPerSec: 100; nBlockAlign: 1; wBitsPerSample: 8);
 Msg: TMsg;

begin
 hScreen := GetDC(0);
 hCanvas := CreateCompatibleDC(0);
 SelectObject(hCanvas, CreateCompatibleBitmap(hScreen, SizeOf(Buffer) * 3, $FF));
 hWhite := CreatePen(PS_SOLID, 1, $FFFFFF);
 hGray := CreatePen(PS_SOLID, 1, $404040);
 ReleaseDC(0, hScreen);

 WndClass.hCursor := CreateCursor(HInstance, 5, 5, 9, 9, PChar(#255#255#255#255#255#255#255#255#247#255#255#255#255#255#255#255#255#255), PChar(#8#8#8#8#8#8#28#28#255#128#28#8#8#8#8#8#8#0));
 RegisterClass(WndClass);
 hBrush := CreateSolidBrush(0);
 hWnd := CreateWindowEx(WS_EX_TOOLWINDOW + WS_EX_LAYERED, WndClass.lpszClassName, WndClass.lpszClassName, WS_VISIBLE, 0, 0, 0, $FF, 0, 0, hInstance, nil);
 GetClientRect(hWnd, Rect);
 SetWindowPos(hWnd, HWND_TOPMOST, 6, 6, SizeOf(Buffer) * 3 + 4, $FF + ($FF - Rect.Bottom), 0);
 SetLayeredWindowAttributes(hWnd, 0, 224, LWA_ALPHA);

 mixerOpen(@waveIn, 0, 0, 0, MIXER_OBJECTF_WAVEIN);
 mixerGetLineInfo(waveIn, @MixerLine, MIXER_GETLINEINFOF_COMPONENTTYPE);
 LineControls.dwLineID := MixerLine.dwLineID;
 LineControls.cControls := MixerLine.cControls;
 mixerGetLineControls(waveIn, @LineControls, MIXER_GETLINECONTROLSF_ALL);
 Details.dwControlID := Controls[0].dwControlID;
 Value := Byte(Controls[0].dwControlType = MIXERCONTROL_CONTROLTYPE_VOLUME) * $FFFF;
 MixerSetControlDetails(waveIn, @Details, MIXER_SETCONTROLDETAILSF_VALUE);
 Details.dwControlID := Controls[1].dwControlID;
 Value := Byte(Controls[1].dwControlType = MIXERCONTROL_CONTROLTYPE_VOLUME) * $FFFF;
 MixerSetControlDetails(waveIn, @Details, MIXER_SETCONTROLDETAILSF_VALUE);
 mixerClose(waveIn);

 waveInOpen(@waveIn, WAVE_MAPPER, @FormatEx, Cardinal(@WaveInProc), HInstance, CALLBACK_FUNCTION);
 waveInPrepareHeader(waveIn, @WaveInHdr, SizeOf(WaveInHdr));
 waveInAddBuffer(waveIn, @WaveInHdr, SizeOf(WaveInHdr));
 waveInStart(waveIn);

 repeat GetMessage(Msg, 0, 0, 0);
  DispatchMessage(Msg);
 until Msg.message = WM_QUIT;
end.

Esta es una pequeña prueba que creé hace algún tiempo, es un osciloscopio (scope ~ oscilloscope), de la salida de sonido. No funciona adecuadamente en algunos ordenadores pero en la mayoría si. Tampoco esta "afinada" pero cuanto tenga más tiempo libre lo haré!

Nota; El Stereo Mix NO debe estar en silencio. Les adjunto la fuente compilada para que lo prueben en caso de no poder compilarlo.

PD; Espero ésto deje de ser un monologo

Saludos

[[seoane]]

Empezado por cHackAll

PD; Espero ésto deje de ser un monologo

Ahora sabes como me sentía yo

Y con respecto a tu osciloscopio, esta bastante bien, me recuerda a un programita que colgué por aquí hace tiempo (onda creo que lo llame). Por supuesto el tuyo es mucho mas ligero, ya que, como es habitual en ti, no usas la VCL.

Espero que alguien mas se una al código inútil, ahora que yo lo tengo un poco abandonado

[[seoane]]

Bueno, aquí dejo como comprimir ficheros en un archivo zip usando la capacidad del windows XP de tratar los archivos zip como carpetas.

Código Delphi [-]
uses ComObj;

function NewZip(Zipfile: String): Boolean;
var
  F: File;
begin
  Result:= FALSE;
  AssignFile(F,Zipfile);
  {$I-}
    Rewrite(F,1);
  {$I+}
  if IOResult=0 then
  begin
    try
      BlockWrite(F,PChar(#80#75#5#6#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0)^,22);
      Result:= TRUE;
    except
    end;
    CloseFile(F);
  end;
end;

function AddToZip(Filename, Zipfile: Variant): Boolean;
var
  Shell: Variant;
begin
  try
    Shell:= CreateOleObject('Shell.Application');
    Shell.NameSpace(zipfile).CopyHere(Filename);
    Result:= TRUE;
  except
    Result:= FALSE;
  end;
end;

// Para crear el zip
NewZip('c:\prueba.zip');
AddToZip(ParamStr(0),'c:\prueba.zip');
// O incluso un directorio entero
AddToZip('c:\prueba','c:\prueba.zip');

Lo pongo en la sección de código inútil (además de para levantar un poco el hilo ) porque la compresión se realiza de forma asíncrona, y no he encontrado una forma (al menos no ninguna seria) de saber cuando se ha terminado de añadir los ficheros al zip, lo que hace difícil de utilizar este código.

[Khronos]

Bueno, veo que el hilo esta un poco abandonado y pensé: "vamos a revivir el hilo con más código inútil"

Bueno el siguiente código son copias "baratas" de las funciones ExtractFileName, ExtractFileExt y ExtractFilePath pero menos sofisticadas que las que vienen en la unidad SysUtils

Código Delphi [-]
function ExtractFileNameW(const FileName: string): string;
var
i: integer;
begin
  result:= EmptyStr;
  for i := Length(FileName) downto 0 do
      begin
        if FileName[i] = '\' then
          begin
            result:= Copy(FileName, i + 1, length(FileName));
            break;
          end;
      end;
end;

function ExtractFileExtW(const FileName: string): string;
var
i: integer;
begin
result:= EmptyStr;
for i := Length(FileName) downto 0 do
  begin
      if FileName[i] = '.' then
        begin
          result:= Copy(FileName, i + 1, length(FileName));
          break;
        end;
  end;
end;

function ExtractFilePathW(const FileName: string): string;
var
i: integer;
begin
result:= EmptyStr;
  for I := Length(FileName) downto 0  do
    begin
      if FileName[i] = '\' then
        begin
          result:= Copy(FileName, 0, i);
          Break;
        end;
    end;

end;

Un ejemplo de llamada:

Código Delphi [-]
   showmessage(ExtractFilePathW(paramstr(0)));
   showmessage(ExtractFileExtW(paramstr(0)));
   showmessage(ExtractFileNameW(paramstr(0)));

Salu2